通过从全局地址簿中选择地址来在用户表单中设置标签标题

Question

在 Outlook 用户表单中，我想使用从全局地址列表中选择的电子邮件地址为标签（“CourrielSup”）添加标题。

使用 Microsoft 知识库中的

SelectNamesDialog.Display

方法，我可以访问全球地址簿。当我单击命令按钮“ListeAdresse”时，会弹出显示地址簿的对话框。

我找不到让所选电子邮件地址成为我的标签标题的方法。

Private Sub ListeAdresse_Click()
 Dim Courriel As String
 Dim oDialog As SelectNamesDialog
 Set oDialog = Application.Session.GetSelectNamesDialog
 With oDialog
 .InitialAddressList = Application.Session.GetGlobalAddressList
 If .Display Then
    CourrielSup.Caption = .Recipients
 End If
 End With
End Sub

Answer 1

这对我有用：

Sub ListeAdresse_Click()
    Const PR_SMTP_ADDRESS As String = _
        "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
 
    Dim dlg As SelectNamesDialog, recip As Recipient
    
    Set dlg = Application.Session.GetSelectNamesDialog
    
    With dlg
        .InitialAddressList = Application.Session.GetGlobalAddressList
        If .Display Then
            Set recip = .Recipients(1)
            'get the address property
            Debug.Print recip.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
        End If
    End With
End Sub

获取财产：
https://learn.microsoft.com/en-us/office/vba/api/outlook.propertyaccessor.getproperty

Answer 2

我最终找到了一种方法，通过使用遇到与 SelectNamesDialog.Display 相关的另一个问题的人的一些代码来制作弗兰肯代码。 我完全意识到生成的代码非常难看。如果有人好心地帮助我让它变得漂亮，或者向我解释我最初所做的代码之间的逻辑差异，我会很兴奋。

Private Sub ListeAdresse_Click()

 Dim EmailAddress As String
 Dim myAddrEntry As AddressEntry
 Dim exchUser As Outlook.ExchangeUser
 Dim oDialog As SelectNamesDialog
 Set oDialog = Application.Session.GetSelectNamesDialog
 
 With oDialog
 .InitialAddressList = Application.Session.GetGlobalAddressList
 .ShowOnlyInitialAddressList = True

        If .Display Then

          AliasName = oDialog.Recipients.Item(1).Name

            Set myAddrEntry = Application.Session.GetGlobalAddressList.AddressEntries(AliasName)
            Set exchUser = myAddrEntry.GetExchangeUser

            If Not exchUser Is Nothing Then
               EmailAddress = exchUser.PrimarySmtpAddress

            End If
            CourrielSup.Caption = EmailAddress
   End If
    End With
Set olApp = Nothing
Set oDialog = Nothing
Set oGAL = Nothing
Set myAddrEntry = Nothing
Set exchUser = Nothing

End Sub