0

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
  • How do you iterate over all recipients after the dialog is closed? In the code listed above only the first recipient is checked. – Eugene Astafiev Jun 08 '20 at 15:52
  • Hi, I haven't written that part yet, but I plan to put in a simple loop using `Recipients.Count` that will pull out all the details for each Exchange User. The only part I can't seem to pull out is whether the user selected them as CC or BCC. – SpikeManZombie Jun 08 '20 at 16:19
  • 1
    Did you try to use the `Logon` method to log into a specific account? – Eugene Astafiev Jun 08 '20 at 16:27
  • Could you also specify the Outlook version with the build numbers? – Eugene Astafiev Jun 08 '20 at 16:28
  • I'm not familiar with that command, but will go research and let you know.If it makes any difference, this is for a a team, so anyone of us (~15 people) may load up this MS Word file, logged into the network, and run this mail merge tool. I already have other code that pulls their network name to display on the userform. – SpikeManZombie Jun 08 '20 at 16:30
  • Did the `Logon` method help? – Eugene Astafiev Jun 09 '20 at 14:05
  • Hi @EugeneAstafiev have been reading MS Office Dev webpage on `NameSpace.Logon` method. Thanks for pointing me in this direction. Our corporate machines are networked (currently via VPN through personal broadband working at home) on Exchange servers running Office 365. In product info it says MS Office Professional Plus 2013. If I have understood `LOGON` correctly, because Outlook is already running, I would not need to use this method to initialise Outlook. But, am going to re-write to incorporate & see what happens – SpikeManZombie Jun 09 '20 at 14:14
  • The `LOGON` command worked! No idea why, but it works exactly as needed. Thank you very much @Eugene, much appreciated :) – SpikeManZombie Jun 09 '20 at 14:51

1 Answers1

0

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