Extract Outlook UserDefinedProperties field - vba

Question

I add UserDefinedProperties in Outlook with the below code
Sub AddStatusProperties()
Dim objNamespace As NameSpace
Dim objFolder As Folder
Dim objProperty As UserDefinedProperty
Set objNamespace = Application.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
With objFolder.UserDefinedProperties
Set objProperty = .Add("MyNotes1", olText, 1)
End With
End Sub
The user can add a value to MyNotes1 field in any email.
Public Sub EditField()
Dim obj As Object
Dim objProp As Outlook.UserProperty
Dim strNote As String, strAcct As String, strCurrent As String
Dim propertyAccessor As Outlook.propertyAccessor
Set obj = Application.ActiveExplorer.Selection.Item(1)
On Error Resume Next
Set UserProp = obj.UserProperties.Find("MyNotes1")
If Not UserProp Is Nothing Then
strCurrent = obj.UserProperties("MyNotes1").Value
End If
Dim varArrayList As Variant
Dim varArraySelected As Variant
varArrayList = Array("value1", "value2", "value3")
varArraySelected = SelectionBoxMulti(List:=varArrayList, Prompt:="Select one or more values", _
SelectionType:=fmMultiSelectMulti, Title:="Select multiple")
If Not IsEmpty(varArraySelected) Then 'not cancelled
For i = LBound(varArraySelected) To UBound(varArraySelected)
If strNote = "" Then
strNote = varArraySelected(i)
Else
strNote = strNote & ";" & varArraySelected(i)
End If
Next i
End If
Set objProp = obj.UserProperties.Add("MyNotes1", olText, True)
objProp.Value = strNote
obj.Save
Err.Clear
Set obj = Nothing
End Sub
I need to extract all email properties including the values available under MyNotes field to Excel. How do I recall MyNotes1 values?
This is the Excel code. The part I miss is "myArray(6, i - 1) = item.?????".
Public Sub getEmails()
On Error GoTo errhand:
Dim outlook As Object: Set outlook = CreateObject("Outlook.Application")
Dim ns As Object: Set ns = outlook.GetNamespace("MAPI")
'This option open a new window for you to select which folder you want to work with
Dim olFolder As Object: Set olFolder = ns.PickFolder
Dim emailCount As Long: emailCount = olFolder.Items.Count
Dim i As Long
Dim myArray As Variant
Dim item As Object
ReDim myArray(6, (emailCount - 1))
For i = 1 To emailCount
Set item = olFolder.Items(i)
If item.Class = 43 And item.ConversationID <> vbNullString Then
myArray(0, i - 1) = item.Subject
myArray(1, i - 1) = item.SenderName
myArray(2, i - 1) = item.To
myArray(3, i - 1) = item.CreationTime
myArray(4, i - 1) = item.ConversationID
myArray(5, i - 1) = item.Categories
'myArray(6, i - 1) = item.?????
End If
Next
With ActiveSheet
.Range("A1") = "Subject"
.Range("B1") = "From"
.Range("C1") = "To"
.Range("D1") = "Created"
.Range("E1") = "ConversationID"
.Range("F1") = "Category"
.Range("G1") = "MyNote"
.Range("A2:G" & (emailCount + 1)).Value = TransposeArray(myArray)
End With
Exit Sub
errhand:
Debug.Print Err.Number, Err.Description
End Sub

Answer 1

You already have code that retrieves that property
Set UserProp = item.UserProperties.Find("MyNotes1")
If Not UserProp Is Nothing Then
myArray(6, i - 1) = UserProp.Value
End If