出口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