vba - 将 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

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