Блог

Я добавляю пользовательские свойства в Outlook с помощью приведенного ниже кода

 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
 

Пользователь может добавить значение в поле MyNotes1 в любом электронном письме.

 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 amp; ";" amp; 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
 

Мне нужно извлечь все свойства электронной почты, включая значения, доступные в поле MyNotes, в Excel. Как мне вспомнить значения MyNotes1?

Это код Excel. Часть, которую я пропускаю, — это «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" amp; (emailCount   1)).Value = TransposeArray(myArray)
End With

Exit Sub

errhand:
Debug.Print Err.Number, Err.Description
End Sub
 

У вас уже есть код, который извлекает это свойство

 Set UserProp = item.UserProperties.Find("MyNotes1")
If Not UserProp Is Nothing Then
    myArray(6, i - 1) = UserProp.Value
End If