如何使用全局地址列表中的 VBA GetSelectNameDialog 确定 CC / BCC 选择

Question

你好知识渊博的人！

背景：

我正在为我们的团队在 MS Word VBA 中开发一个自定义邮件合并工具，以便我们拥有超出标准 Office Word 邮件合并包的额外功能。第三方产品或插件不可能。但是，自动附加特定文件、自定义主题行等的能力将为我们节省大量时间和精力。

其中一项功能是使用户能够从我们的公司 Microsoft Exchange 全球地址列表 (GAL) 中选择额外的抄送 (CC) 或密件抄送 (BCC) 电子邮件帐户以附加到邮件合并中。用户可能需要选择多个抄送或密送电子邮件帐户。

问题：

使用以前的问题和答案 (30918152) 我能够调用地址簿 GAL 并自定义 To: / CC: / BCC : 标签。该代码能够检索.Recipients 集合中选定的交换帐户，但我正在努力确定哪些选择是CC 或BCC。

我知道Outlook.Recipient.Type 返回一个变量类型Long，它与From: / To: / CC: / BCC: 但是，当我debug.print 'recipient.type' 总是返回 1 时，即使选择了 CC 或 BCC。

有人知道我哪里出错了吗？

目前的进展：

我搜索了 MSDN，运行了多个网络搜索并搜索了 Stack Overflow、VBOffice.net 等地方，但没有找到我想要的东西。我是自学成才，所以怀疑我的根本问题是对 SelectNamesDialog.Recipients 上的 MSDN 页面缺乏了解

代码：

Private Sub cmdSetProjectMember1_Click()
' CODE TO SELECT FROM ADDRESS BOOK AND TAKE EMAIL ADDRESS WHEN IT IS AN EXCHANGE USER.
' TAKEN FROM https://stackoverflow.com/questions/30918152/opening-outlook-address-book-from-excel

  Dim olApp As Outlook.Application
  Dim oDialog As SelectNamesDialog
  Dim oGAL As AddressList
  Dim myAddrEntry As AddressEntry
  Dim exchUser As Outlook.ExchangeUser
  Dim TEST_Recipient As Outlook.Recipient

  Dim AliasName As String
  Dim FirstName As String
  Dim LastName As String
  Dim EmailAddress As String

    Set aOutlook = GetObject(, "Outlook.Application")
    Set oDialog = aOutlook.Session.GetSelectNamesDialog
    Set oGAL = aOutlook.GetNamespace("MAPI").AddressLists("Global Address List")

    With oDialog
        .AllowMultipleSelection = True
        .InitialAddressList = oGAL
        .ShowOnlyInitialAddressList = True
        .Caption = "Custom mail merge tool  *****  | |  *****  SELECT EMAIL FROM ADDRESS BOOK"
        .NumberOfRecipientSelectors = olShowToCc
        .ToLabel = "Select CC:"
        .CcLabel = "Select BCC:"

        If .Display Then
                AliasName = oDialog.Recipients.Item(1).Name
                Set myAddrEntry = oGAL.AddressEntries(AliasName)
                Set exchUser = myAddrEntry.GetExchangeUser

                If Not exchUser Is Nothing Then
                    FirstName = exchUser.FirstName
                    LastName = exchUser.LastName
                    EmailAddress = exchUser.PrimarySmtpAddress

                    'MsgBox "You selected contact: " & vbNewLine & _
                        '"FirstName: " & FirstName & vbNewLine & _
                        '"LastName:" & LastName & vbNewLine & _
                        '"EmailAddress: " & EmailAddress

                Set TEST_Recipient = oDialog.Recipients.Item(1)
                 Debug.Print TEST_Recipient.Type

                 If TEST_Recipient.Type = olCC Then
                    MsgBox "Carbon Copy"

                Else
                    MsgBox "NOT CC"

                End If

            End If

        End If

    End With

 Set olApp = Nothing
 Set oDialog = Nothing
 Set oGAL = Nothing
 Set myAddrEntry = Nothing
 Set exchUser = Nothing

End Sub

Answer 1

感谢 @Eugene 帮助将我指向 LOGON

由于某些原因，由于 Outlook 已经在运行，通讯簿实例在通过 MS Word VBA 再次单独调用时无法提取详细信息。

这是我完成这项工作的最终代码，其中包含一个用于捕获多个 CC / BCC 选择的详细信息的循环。

Private Sub cmdSetProjectMember1_Click()
' CODE TO SELECT FROM ADDRESS BOOK AND TAKE EMAIL ADDRESS WHEN IT IS AN EXCHANGE USER.
' TAKEN FROM https://stackoverflow.com/questions/30918152/opening-outlook-address-book-from-excel

  Dim olApp As Outlook.Application
  Dim oNS As Outlook.Namespace
  Dim oDialog As SelectNamesDialog
  Dim oGAL As AddressList
  Dim myAddrEntry As AddressEntry
  Dim exchUser As Outlook.ExchangeUser
  Dim TEST_Recipient As Outlook.Recipient

  Dim AliasName As String
  Dim FirstName As String
  Dim LastName As String
  Dim EmailAddress As String

  ' New dimension variables to capture multiple address book selections
  Dim iRecipientCount As Integer
  Dim iLoop As Integer

    Set aOutlook = GetObject(, "Outlook.Application")

    ' New code for LOGON inserted here
    Set oNS = aOutlook.GetNamespace("MAPI")
    oNS.Logon "LatestProfile", , True, True


    Set oDialog = aOutlook.Session.GetSelectNamesDialog
    Set oGAL = aOutlook.GetNamespace("MAPI").AddressLists("Global Address List")

    With oDialog
        .AllowMultipleSelection = True
        .InitialAddressList = oGAL
        .ShowOnlyInitialAddressList = True
        .Caption = "Custom mail merge tool  *****  | |  *****  SELECT EMAIL FROM ADDRESS BOOK"
        .NumberOfRecipientSelectors = olShowToCcBcc
        .ToLabel = "Select FROM:"
        .CcLabel = "Select CC:"
        .BccLabel = "Select BCC:"

        If .Display Then
          AliasName = oDialog.Recipients.Item(1).Name
          Set myAddrEntry = oGAL.AddressEntries(AliasName)
          Set exchUser = myAddrEntry.GetExchangeUser

          If Not exchUser Is Nothing Then
            iRecipientCount = oDialog.Recipients.Count

            For iLoop = 1 To iRecipientCount
              Set TEST_Recipient = oDialog.Recipients.Item(iLoop)

              Debug.Print TEST_Recipient.Index
              Debug.Print TEST_Recipient.Type
              Debug.Print "NEXT"

              Select Case TEST_Recipient.Type
                Case 1
                  MsgBox TEST_Recipient.Name & vbNewLine & "Selected FROM:"

                Case 2
                  MsgBox TEST_Recipient.Name & vbNewLine & "Selected CC:"

                Case 3
                  MsgBox TEST_Recipient.Name & vbNewLine & "Selected BCC:"

               End Select

            Next iLoop

          End If

        End If

    End With

 Set olApp = Nothing
 Set oDialog = Nothing
 Set oGAL = Nothing
 Set myAddrEntry = Nothing
 Set exchUser = Nothing

End Sub