出口Outlook 2013中搜索文件夾的郵件到Excel

Question

我想出口我的電子郵件中搜索文件夾到Excel。

我使用下面的代碼來導出我的電子郵件收件箱中。

但隨着搜索文件夾它給了我一個錯誤：

運行時錯誤「-2147221233（8004010F）

嘗試的操作失敗。找不到對象。

Sub Download_Outlook_Mail_To_Excel() 

Dim folders As Outlook.folders 
Dim folder As Outlook.MAPIFolder 
Dim iRow As Integer 
Dim Pst_Folder_Name 
Dim MailboxName 

MailboxName = "xxx@yy.com" 
Pst_Folder_Name = "Inbox" 

Set folder = Outlook.Session.folders(MailboxName).folders(Pst_Folder_Name) 

Sheets(1).Activate 

For iRow = 1 To folder.Items.Count 
    Sheets(1).Cells(iRow, 1).Select 
    Sheets(1).Cells(iRow, 1) = folder.Items.Item(iRow).SenderName 
    Sheets(1).Cells(iRow, 2) = folder.Items.Item(iRow).Subject 
    Sheets(1).Cells(iRow, 3) = folder.Items.Item(iRow).ReceivedTime 
    Sheets(1).Cells(iRow, 4) = folder.Items.Item(iRow).Categories 
Next iRow 

MsgBox "Outlook Mails Extracted to Excel" 

End Sub 

Answer 1

我終於找到了解決辦法。它只適用於一個指定的搜索文件夾，在變量中命名爲：Pst_Folder_Name。如果你有更多的搜索文件夾，你必須以某種方式使用循環。

Sub Outlook_Emails_Handled_Last_Week() 
    Dim colStores As Outlook.Stores 
    Dim oStore As Outlook.Store 
    Dim oSearchFolders As Outlook.folders 
    Dim oFolder As Outlook.folder 
    Dim mail As Outlook.MailItem 
    Dim iRow As Integer 
    Dim Pst_Folder_Name 
    Dim MailboxName 
    Dim Ws As Excel.Worksheet 
    Dim LastRow As Integer 

    MailboxName = "xxxx@yyy.com" 
    Pst_Folder_Name = "Emails Handled Last Week" 

    Set oFolder = Session.Stores.Item(MailboxName).GetSearchFolders(Pst_Folder_Name) 

    Set Ws = ThisWorkbook.Worksheets("Sheet1") 
    Ws.Activate 

    LastRow = Ws.Range("A" & Ws.Rows.Count).End(xlUp).Row 

     Ws.Cells(1, 1).Value = "Sender Name" 
     Ws.Cells(1, 2).Value = "Subject" 
     Ws.Cells(1, 3).Value = "Received Time" 
     Ws.Cells(1, 4).Value = "Categories" 

    For iRow = 1 To oFolder.Items.Count 
     Ws.Cells(LastRow + iRow, 1) = oFolder.Items.Item(iRow).SenderName 
     Ws.Cells(LastRow + iRow, 2) = oFolder.Items.Item(iRow).Subject 
     Ws.Cells(LastRow + iRow, 3) = oFolder.Items.Item(iRow).ReceivedTime 
     Ws.Cells(LastRow + iRow, 4) = oFolder.Items.Item(iRow).Categories 

    Next iRow 

    MsgBox "Completed!" 

    End Sub 

Answer 2

由於搜索文件夾可以預先指定或定製，以檢測它們的最好方法是檢查該文件夾的.Class，這應該是olSearch。

所以這應該工作（我添加了一個新的整數繼續寫作，如果有一個以上的搜索文件夾）：

Sub Download_Outlook_Mail_To_Excel() 

Dim folder As Outlook.MAPIFolder 
Dim iRow As Integer 
Dim LastWrow As Integer 
Dim MailboxName As String 
Dim Ws As Excel.Worksheet 

MailboxName = "xxyy@zzz.com" 
Set Ws = sheets(1) 

For Each folder In Outlook.Session.folders(MailboxName).folders 
    With folder 
     If .Class <> olSearch Then 
     Else 
      Ws.Activate 
      LastWrow = Ws.Range("A" & Ws.rows.Count).End(xlup).Row 
      For iRow = 1 To .Items.Count 
       'ws.Cells(iRow, 1).Select 
       Ws.Cells(LastWrow + iRow, 1) = .Items.Item(iRow).SenderName 
       Ws.Cells(LastWrow + iRow, 2) = .Items.Item(iRow).Subject 
       Ws.Cells(LastWrow + iRow, 3) = .Items.Item(iRow).ReceivedTime 
       Ws.Cells(LastWrow + iRow, 4) = .Items.Item(iRow).Categories 
      Next iRow 
     End If 
    End With 
Next folder 

MsgBox "Outlook Mails Extracted to Excel" 

End Sub