时间戳

首页 > 解决方案 > 提取 Outlook UserDefinedProperties 字段

vba - 提取 Outlook UserDefinedProperties 字段

问题描述

我使用以下代码在 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

标签： vbaoutlook

解决方案

您已经拥有检索该属性的代码

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

推荐阅读