提取 Outlook UserDefinedProperties 字段

Question

我使用以下代码在 Outlook 中添加 UserDefinedProperties

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 & ";" & 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" & (emailCount + 1)).Value = TransposeArray(myArray)
End With

Exit Sub

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

Answer 1

您已经有检索属性

的代码

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

提取 Outlook UserDefinedProperties 字段

Extract Outlook UserDefinedProperties field

outlook

vba