当然可以直接把本地Outlook联系人关联到你的Excel VBA用户窗体里的多选列表！这绝对比手动添加几十条联系人高效太多，还能保证收件人信息和Outlook同步。下面是一步步的实现方案，结合你现有的代码修改：

1. 准备用户窗体控件 #

首先在你的UserForm里添加一个ListBox控件（不是普通的ComboBox，因为要支持多选），然后在属性窗口里把它的MultiSelect属性设置为fmMultiSelectMulti（点击多选）或者fmMultiSelectExtended（按住Ctrl/Shift多选），这样用户就能灵活选择多个收件人了。

2. 加载Outlook联系人到ListBox #

在UserForm的Initialize事件中编写代码，自动拉取Outlook默认联系人文件夹里的联系人，仅添加有邮箱地址的条目：

Private Sub UserForm_Initialize()
    Dim objOutlook As Object
    Dim objNamespace As Object
    Dim objContactsFolder As Object
    Dim objContact As Object
    
    ' 清空列表框原有内容
    Me.ListBox1.Clear
    
    ' 连接Outlook应用
    Set objOutlook = CreateObject("Outlook.Application")
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    ' 获取Outlook默认联系人文件夹（10对应olFolderContacts常量）
    Set objContactsFolder = objNamespace.GetDefaultFolder(10)
    
    ' 遍历所有联系人，筛选出有邮箱的添加到列表
    For Each objContact In objContactsFolder.Items
        If objContact.Email1Address <> "" Then
            ' 显示为「姓名 <邮箱>」格式，方便用户识别
            Me.ListBox1.AddItem objContact.FullName & " <" & objContact.Email1Address & ">"
        End If
    Next objContact
    
    ' 释放资源
    Set objContact = Nothing
    Set objContactsFolder = Nothing
    Set objNamespace = Nothing
    Set objOutlook = Nothing
End Sub

3. 修改邮件发送逻辑，获取选中的收件人 #

接下来修改你原来的邮件发送代码，从ListBox中收集用户选中的收件人，拼接成Outlook能识别的分号分隔格式：

Private Sub CommandButton_Send_Click() ' 替换成你实际的发送按钮事件名
    Dim varResult As String
    ' 这里替换成你实际的PDF保存路径（比如之前的文件选择逻辑）
    varResult = "C:\Temp\ExportedForm.pdf"
    
    ' 保留你原来的PDF导出代码
    ActiveSheet.ExportAsFixedFormat Filename:=varResult, Type:=xlTypePDF, _
        OpenAfterPublish:=True, IncludeDocProperties:=True
    
    Dim objOutlook As Object
    Dim objMail As Object
    Dim selectedRecipients As String
    Dim i As Integer
    
    ' 收集选中的收件人邮箱
    selectedRecipients = ""
    For i = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) Then
            ' 用分号分隔多个收件人
            If selectedRecipients <> "" Then selectedRecipients = selectedRecipients & "; "
            ' 从「姓名 <邮箱>」格式中提取纯邮箱地址
            selectedRecipients = selectedRecipients & Mid(Me.ListBox1.List(i), _
                InStr(Me.ListBox1.List(i), "<") + 1, _
                InStr(Me.ListBox1.List(i), ">") - InStr(Me.ListBox1.List(i), "<") - 1)
        End If
    Next i
    
    ' 校验是否选择了收件人
    If selectedRecipients = "" Then
        MsgBox "请至少选择一个收件人再发送！", vbExclamation
        Exit Sub
    End If
    
    ' 创建并发送邮件
    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
    With objMail
        .To = selectedRecipients
        .Subject = "finished userform"
        .Body = "automatically sent mail. UserForm attached."
        .Attachments.Add varResult
        .Send ' 自动发送，若想先预览邮件可改为.Display
    End With
    
    UserForm.Hide
    
    ' 释放资源
    Set objMail = Nothing
    Set objOutlook = Nothing
End Sub

一些实用提示 #

• Outlook权限提示：第一次运行时Outlook可能会弹出安全警告，允许VBA访问联系人即可；企业环境下可能需要IT配置信任策略。
• 联系人筛选：如果联系人太多，可以添加筛选逻辑（比如只显示特定联系人组），或者给ListBox加搜索框，提升用户体验。
• 错误处理：建议添加On Error Resume Next或On Error GoTo逻辑，捕获Outlook未启动、PDF导出失败等异常情况。
• 显示格式自定义：如果不需要显示姓名，直接把邮箱添加到ListBox即可，这样提取的时候更简单。

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