将 Outlook 2013 搜索文件夹电子邮件导出到 Excel

Question

我想将搜索文件夹中的电子邮件导出到Excel。

我正在使用下面的代码导出收件箱中的电子邮件。

但是对于搜索文件夹，它给我一个错误：

Run-time error '-2147221233 (8004010f)

The attempted operation failed. An object could not be found.

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

由于搜索文件夹可以预先分配或自定义，检测它们的最佳方法是检查文件夹的 .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

Answer 2

我终于找到了解决办法。它仅适用于一个指定的搜索文件夹，在变量中命名：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

将 Outlook 2013 搜索文件夹电子邮件导出到 Excel

Export Outlook 2013 Search Folders emails to Excel

excel

outlook

vba