將Outlook電子郵件中的電子郵件導出到Excel中。編碼問題

我正在處理以下代碼，並試圖從Outlook中的兩個不同文件夾中添加電子郵件，但我明顯錯過了某些內容，因爲它不起作用。當我運行代碼時，它會從「PolicyCenter」文件夾中取出所有電子郵件，而不是「Apex」文件夾。我不確定我在做什麼錯誤，任何幫助或建議將不勝感激！將Outlook電子郵件中的電子郵件導出到Excel中。編碼問題

Option Explicit 
Sub VBA_Export_Outlook_Emails_To_Excel() 
Dim Folder As Outlook.MAPIFolder 
Dim sFolders As Outlook.MAPIFolder 
Dim iRow As Integer, oRow As Integer 
Dim MailBoxName As String, Pst_Folder_Name As String 

MailBoxName = "Mailbox, PL-SYSTEM-OUTAGES" 

Pst_Folder_Name = "Apex" 
Pst_Folder_Name = "PolicyCenter" 

    For Each Folder In Outlook.Session.Folders(MailBoxName).Folders 
    If VBA.UCase(Folder.Name) = VBA.UCase(Pst_Folder_Name) Then GoTo Label_Folder_Found 
    For Each sFolders In Folder.Folders 
     If VBA.UCase(sFolders.Name) = VBA.UCase(Pst_Folder_Name) Then 
      Set Folder = sFolders 
      GoTo Label_Folder_Found 
     End If 
    Next sFolders 
Next Folder 

Label_Folder_Found: 
If Folder.Name = "" Then 
    MsgBox "Invalid Data in Input" 
    GoTo End_Lbl1: 
End If 

ThisWorkbook.Sheets(1).Activate 
Folder.Items.Sort "Received" 

ThisWorkbook.Sheets(1).Cells(1, 1) = "Sender" 
ThisWorkbook.Sheets(1).Cells(1, 2) = "Subject" 
ThisWorkbook.Sheets(1).Cells(1, 3) = "Date" 
ThisWorkbook.Sheets(1).Cells(1, 4) = "Size" 
'ThisWorkbook.Sheets(1).Cells(1, 5) = "EmailID" 
'ThisWorkbook.Sheets(1).Cells(1, 6) = "Body" 

oRow = 1 
For iRow = 1 To Folder.Items.Count 

    If VBA.DateValue(VBA.Now) - VBA.DateValue(Folder.Items.Item(iRow).ReceivedTime) <= 60 Then 
     oRow = oRow + 1 
     ThisWorkbook.Sheets(1).Cells(oRow, 1).Select 
     ThisWorkbook.Sheets(1).Cells(oRow, 1) = Folder.Items.Item(iRow).SenderName 
     ThisWorkbook.Sheets(1).Cells(oRow, 2) = Folder.Items.Item(iRow).Subject 
     ThisWorkbook.Sheets(1).Cells(oRow, 3) = Folder.Items.Item(iRow).ReceivedTime 
     ThisWorkbook.Sheets(1).Cells(oRow, 4) = Folder.Items.Item(iRow).Size 
     'ThisWorkbook.Sheets(1).Cells(oRow, 5) = Folder.Items.Item(iRow).SenderEmailAddress 
     'ThisWorkbook.Sheets(1).Cells(oRow, 6) = Folder.Items.Item(iRow).Body 
    End If 
Next iRow 
MsgBox "Outlook Mails Extracted to Excel" 
Set Folder = Nothing 
Set sFolders = Nothing 

End_Lbl1: 
End Sub

謝謝！ -D

來源

2016-11-22 Deke

你設置'Pst_Folder_Name =「頂點」'然後在下一行代碼用'Pst_Folder_Name =「策略中心」'覆蓋它。所以代碼從未運行「Apex」。 – xidgel

好吧，有沒有辦法得到它，所以它會複製這兩個文件夾的內容？我正在解決一些問題。 – Deke

會在兩個下一個語句之間放置「新文件夾名稱」嗎？下一個sFolders Pst_Folder_Name =「PolicyCenter」下一個文件夾 –

會把兩個下一個語句之間的「新文件夾名稱」嗎？

Next sFolders 
Pst_Folder_Name = "PolicyCenter" 
Next Folder

這樣做是爲了顯示我的意思......

來源

2016-11-22 20:29:27

所以你的意思是在下面的'Pst_Folder_Name =「Apex」爲Outlook.Session.Folders（MailBoxName）.Folders如果VBA.UCase（Folder.Name）= VBA.UCase（Pst_Folder_Name）然後GoTo Label_Folder_Found sFolders在Folder.Folders如果VBA.UCase（sFolders.Name）= VBA.UCase（Pst_Folder_Name）然後設置Folder = sFolders GoTo Label_Folder_Found結束如果下一個sFolders下一個文件夾Pst_Folder_Name =「PolicyCenter」下一個sFolders下一個文件夾'（對不起讓這個顯示正確）但是放在這裏似乎並不奏效。仍然只進口一個文件夾電子郵件 – Deke

我的意思是在下一個文件夾之後，但在下一個文件夾之前 –

也嘗試過。似乎沒有工作。似乎無法弄清楚如何從多個文件夾中獲取此信息，無論我做什麼。任何其他的想法？在過去的兩天裏，我一直在想所有我能想到的事情（限於我知道哪些不是很多）。我的眼睛會掉出我的頭。我只需要把它從多個郵箱中取出所有電子郵件，或者運行我現有的所有模塊（每個模塊設置爲從一個特定的方框中取出電子郵件），然後在下一行可以輸入的表格中輸入，而無需彼此重疊。我非常感謝迄今爲止的幫助。 – Deke

將Outlook電子郵件中的電子郵件導出到Excel中。編碼問題

回答

相關問題