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

Question

Hi knowledgeable people!

Background:

I am developing a custom mail merge tool in MS Word VBA for our team so that we have extra functionality beyond the standard Office Word mail merge package. 3rd party products or add-ons are not possible. But, the ability to automatically attach specific files, custom subject line etc, would save us a lot of time and effort.

One of the features is to enable the user to select additional carbon-copy (CC) or blind carbon-copy (BCC) email accounts to append to the mail merge from our corporate Microsoft Exchange Global Address List (GAL). The user may need to select multiple CC or BCC email accounts.

Problem:

Using a previous question & answer ( 30918152 ) I was able to call the address book GAL and customise the To: / CC: / BCC: labels. The code is able to retrieve the selected exchange accounts in the .Recipients collection, but I am struggling to determine which selections are CC or BCC.

I am aware that Outlook.Recipient.Type returns a variable type Long , which relates to From: / To: / CC: / BCC: But, when I debug.print 'recipient.type' always returns 1 even when CC or BCC is selected.

Does anyone know where I am going wrong?

Progress so far:

I have searched MSDN, run multiple web searches and scoured places like Stack Overflow, VBOffice.net, but haven't what I'm looking for. I am self-taught, so suspect my fundamental problem is lack of understanding of the MSDN page on SelectNamesDialog.Recipients

Code:

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

Thank you to @Eugene for help pointing me to LOGON

For some reason, because Outlook is already running, the instance of the address book couldn't pull through details when called again separately through MS Word VBA.

Here is my final code to make this work, complete with a loop for capturing details for multiple CC / BCC selections.

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