Übergabe von Wert eines benutzdefinierten Feld von Outlook an Word

Sub ShowAddressBook()
    Dim objOL As Object, m As Object, strCustomField As String, strDaten As String
    'Name des benutzerdefinierten Feldes hier anpassen  
    '>>>>>>  
    Const CUSTOMFIELDNAME = "Demofeld"  
    '<<<<<<<  
    
    'Outlook Object holen  
    Set objOL = GetObject(, "Outlook.Application")  
    If objOL Is Nothing Then
        Set objOL = CreateObject("Outlook.Application")  
    End If
    'Dialog fix (bring to front)  
    For Each objExplorer In objOL.Explorers
        objExplorer.WindowState = 1
    Next
    Set m = objOL.CreateItem(0)
    m.Display False
    m.Close 1
    '-----  
    'Addressbuchdialog einrichten  
    With objOL.Session.GetSelectNamesDialog
        'Einzel-Kontaktauswahlmodus  
        .SetDefaultDisplayMode 7
        ' Dialog anzeigen  
        If .Display Then
            'Kontakt von Recipient auflösen  
            Set contact = .Recipients.Item(1).AddressEntry.GetContact
            If Not contact Is Nothing Then
                With contact
                    'Benutzerdefniertes Feld auslesen wenn es vorhanden ist  
                    If Not .Userproperties.Find(CUSTOMFIELDNAME, True) Is Nothing Then
                        strCustomField = .Userproperties.Item(CUSTOMFIELDNAME).Value
                    Else
                        strCustomField = ""  
                    End If
                    'Daten des Kontakts für die Ausgabe aufbereiten  
                    strDaten = .FirstName & " " & .Lastname & vbNewLine & _  
                                .HomeAddressStreet & vbNewLine & _
                                .HomeAddressPostalCode & " " & .HomeAddressCity & vbNewLine & _  
                                strCustomField & vbNewLine
                    'Text an aktueller Position einfügen  
                    Selection.Text = strDaten
                End With
            Else
                'Es wurde kein zugeordneter Kontakt für den Eintrag gefunden  
                MsgBox "Es wurde kein zugeordneter Kontakt gefunden", vbExclamation  
            End If
        End If
    End With
End Sub