Hi knowledgeable people!
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.
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?
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
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
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.