如何在Outlook用户窗体中通过全局地址簿选择邮箱设置标签标题？

你的代码核心问题是直接把SelectNamesDialog.Recipients集合赋值给标签的Caption属性——Recipients是一个对象集合，不是字符串，自然无法正确显示邮箱地址。下面是修正后的实现方案：

场景1：仅允许选择单个联系人 #

如果只需要用户选择一个邮箱地址，可以限制对话框的选择数量，然后直接获取选中收件人的SMTP地址：

Private Sub ListeAdresse_Click()
    Dim oDialog As SelectNamesDialog
    Dim oRecipient As Recipient
    
    Set oDialog = Application.Session.GetSelectNamesDialog
    With oDialog
        .InitialAddressList = Application.Session.GetGlobalAddressList
        .NumberOfRecipientSelectors = olShowTo ' 仅显示收件人栏，限制单选择
        If .Display Then
            Set oRecipient = .Recipients(1)
            CourrielSup.Caption = GetSMTPAddress(oRecipient)
        End If
    End With
End Sub

' 辅助函数：兼容Exchange和普通邮箱的SMTP地址获取
Private Function GetSMTPAddress(ByVal oRecip As Recipient) As String
    Dim oExUser As ExchangeUser
    Dim oExDistList As ExchangeDistributionList
    
    Select Case oRecip.AddressEntry.AddressEntryUserType
        Case olExchangeUserAddressEntry
            Set oExUser = oRecip.AddressEntry.GetExchangeUser
            GetSMTPAddress = oExUser.PrimarySmtpAddress
        Case olExchangeDistributionListAddressEntry
            Set oExDistList = oRecip.AddressEntry.GetExchangeDistributionList
            GetSMTPAddress = oExDistList.PrimarySmtpAddress
        Case Else
            GetSMTPAddress = oRecip.Address
    End Select
End Function

场景2：允许选择多个联系人 #

如果需要支持多选，遍历Recipients集合拼接所有选中的邮箱地址：

Private Sub ListeAdresse_Click()
    Dim oDialog As SelectNamesDialog
    Dim oRecipient As Recipient
    Dim strEmails As String
    
    Set oDialog = Application.Session.GetSelectNamesDialog
    With oDialog
        .InitialAddressList = Application.Session.GetGlobalAddressList
        If .Display Then
            ' 遍历所有选中的收件人，拼接邮箱地址
            For Each oRecipient In .Recipients
                strEmails = strEmails & GetSMTPAddress(oRecipient) & ", "
            Next oRecipient
            ' 移除末尾多余的分隔符
            If Len(strEmails) > 0 Then
                strEmails = Left(strEmails, Len(strEmails) - 2)
            End If
            CourrielSup.Caption = strEmails
        End If
    End With
End Sub

' 同场景1的辅助函数
Private Function GetSMTPAddress(ByVal oRecip As Recipient) As String
    Dim oExUser As ExchangeUser
    Dim oExDistList As ExchangeDistributionList
    
    Select Case oRecip.AddressEntry.AddressEntryUserType
        Case olExchangeUserAddressEntry
            Set oExUser = oRecip.AddressEntry.GetExchangeUser
            GetSMTPAddress = oExUser.PrimarySmtpAddress
        Case olExchangeDistributionListAddressEntry
            Set oExDistList = oRecip.AddressEntry.GetExchangeDistributionList
            GetSMTPAddress = oExDistList.PrimarySmtpAddress
        Case Else
            GetSMTPAddress = oRecip.Address
    End Select
End Function

关键说明 #

• 不能直接使用Recipient.Address获取Exchange邮箱地址，否则会返回Exchange内部格式（如EX:/O=组织名/CN=收件人），必须通过ExchangeUser.PrimarySmtpAddress解析出真实SMTP地址。
• 通过.NumberOfRecipientSelectors属性可以限制选择数量：olShowTo对应单选择，olShowToCc/olShowToCcBcc支持多选。

内容的提问来源于stack exchange，提问作者Yeti