使用VBA将元数据从Outlook提取到Excel

Question

我正在尝试从已发送邮件邮箱中提取元数据以进行度量跟踪（发送时间）。

我遇到错误

  

尝试的操作失败。找不到对象。

我尝试了几种不同的代码，但是无法从Outlook中提取任何电子邮件数据。

我确保Outlook 2016和Excel 2016对象在引用下处于活动状态。

Sub GetFromOutlook()

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer

Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("Inbox").Folders("Sent_Items")

i = 1

For Each OutlookMail In Folder.Items
If OutlookMail.ReceivedTime >= Range("From_date").Value Then
    Range("eMail_subject").Offset(i, 0).Value = OutlookMail.Subject
    Range("eMail_date").Offset(i, 0).Value = OutlookMail.ReceivedTime
    Range("eMail_sender").Offset(i, 0).Value = OutlookMail.SenderName
    Range("eMail_text").Offset(i, 0).Value = OutlookMail.Body

    i = i + 1
End If
Next OutlookMail

Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

End Sub

Answer 1

我从Excel / VBA中运行了此代码，它运行良好。只有1行代码给了我错误，因此我更改了它。在这里可以建立对已发送邮件文件夹的引用。

在下面的代码中，将使用Outlook参考模型中定义的默认“已发送邮件”文件夹。

Option Explicit

Sub GetFromOutlook()

    Dim OutlookApp As Outlook.Application
    Dim OutlookNamespace As Namespace
    Dim OutlookRecip As Outlook.Recipient
    Dim Folder As MAPIFolder
    Dim OutlookMail As Variant
    Dim i As Integer

    Set OutlookApp = New Outlook.Application
    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")

    Set OutlookRecip = OutlookNamespace .CreateRecipient("RobEmail@StackOverflow.com") '// Owner's Email / Shared Folder email address
    Set Folder = OutlookNamespace.GetSharedDefaultFolder(OutlookRecip, olFolderSentMail)

    'If you want to refer to Sent Items folder then use this.
    'Set Folder = OutlookNamespace.GetDefaultFolder(olFolderSentMail)
    ' Or if your Sent Email folder is inside the Inbox then use the line below (Just Uncomment the below and Comment the upper one)
    'Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("Sent_Items")

    i = 1

    For Each OutlookMail In Folder.Items
        If OutlookMail.ReceivedTime >= Range("From_date").Value Then
            Range("eMail_subject").Offset(i, 0).Value = OutlookMail.Subject
            Range("eMail_date").Offset(i, 0).Value = OutlookMail.ReceivedTime
            Range("eMail_sender").Offset(i, 0).Value = OutlookMail.SenderName
            Range("eMail_text").Offset(i, 0).Value = OutlookMail.Body

            i = i + 1
        End If
    Next OutlookMail

    Set Folder = Nothing
    Set OutlookNamespace = Nothing
    Set OutlookApp = Nothing

End Sub

---

但是，如果您的“已发送邮件”文件夹位于“收件箱”下或已自定义，请运行下面的代码以获取其确切名称，然后使用它。

For Each Folder In OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders
    Debug.Print Folder.Name
Next

此外，以下是Outlook库中可用文件夹的完整列表。思想对您会有所帮助。