CODEWITHSUNDEEP
vbaoutlook
user3818099
user3818099

Reputation: 21

Extract Outlook UserDefinedProperties field

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

Upvotes: 0

Views: 277

Answers (1)

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66215

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

Upvotes: 1

Related Questions