使用 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 庫中可用文件夾的完整列表。 思想對你有幫助。