Извлечение метаданных из Outlook в Excel с использованием VBA

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.Мысль будет полезна для вас.