Импорт пользовательских полей Outlook в Excel с VBA / макросами

Question

Извините, что беспокою вас, но у меня есть некоторые трудности с одним из моих макросов.

В Excel я хотел бы импортировать данные почты из Outlook. У меня нет проблем с импортом классических полей, таких как: От, Тема ... и т. Д. Но я не могу найти, как импортировать мои "Пользовательские поля".

Пользовательские поля, которые я пытаюсь импортировать, называются «DemandQTY» и содержат только цифры.

Почтовый ящик, из которого я получаю свои данные, является общим почтовым ящиком.

Sub GetFromOutlook()

Dim OutApp As Outlook.Application
Dim OutNS As Namespace
Dim Folder As MAPIFolder
Dim OutMail As Variant
Dim i As Integer
Dim objOwner As Outlook.Recipient
Dim FileName As String
Dim MI As Outlook.MailItem
Dim Item As Object
Dim Atmt As Attachment

Set OutNS = GetNamespace("MAPI")
Set OutApp = New Outlook.Application
Set objOwner = OutNS.CreateRecipient("emailadress")
objOwner.Resolve

If objOwner.Resolved Then
Set Folder = OutNS.GetSharedDefaultFolder(objOwner, olFolderInbox)

i=2
For Each OutMail In Folder.Items

        Sheets(2).Cells(i, 1) = OutMail.EntryID
       (etc....)
        Sheets(2).Cells(i, 32) = OutMail.ReminderTime    
        i = i + 1
Next OutMail
MsgBox "Importation Terminée"
Sheets(2).Select
Sheets(2).Cells(1, 1).Select
Set OutApp = Nothing
Set OutNS = Nothing
Set Folder = Nothing
End If
End Sub

Если честно, я не часто использовал VBA с Outlook. Я пробовал много разных методов, найденных в интернете, но ничего не помогло.

Надеюсь, у кого-нибудь возникнет идея:)

Спасибо,

Answer 1

Мы можем сделать это, сначала проверив, существует ли свойство. Если этого не произойдет, и вы попытаетесь работать с ним, он выдаст ошибку. После этого мы можем получить доступ к значению, если свойство найдено.

For Each OutMail In Folder.Items

        Sheets(2).Cells(i, 1) = OutMail.EntryID
       (etc....)
        Sheets(2).Cells(i, 32) = OutMail.ReminderTime

        If Not(OutMail.UserProperties.Find("DemandQTY", True) Is Nothing) Then    
            Sheets(2).Cells(i, 33) = OutMail.UserProperties("DemandQTY").Value
        End If

        i = i + 1
Next OutMail