Below are two macros to send e-mail or letters your Business Contacts. Running these macros opens a new Marketing Campaign with all
the fields completed. Click "Launch" to open Word, then click "Finish and Merge".
To create a Word e-mail or letter template:
1.) From the Word Ribbon, select "Insert | Quick Parts | Field | Categories:Mail Merge"
2.) Select AddressBlock or use MergeField to select specific fields (e.g. First_Name, Last_Name, Business_Phone, etc.)
3.) Change the template file path in the macro below to point to your Word file
To create these buttons on your Outlook toolbar:
1.) Verify that your security settings will prompt you to run unsigned macros by selecting
"Tools | Trust Center..." from the main Outlook window.
Then click "Macro Security" and select "Warnings for all macros" and click "OK"
2.) Create a Macro from the main Outlook window by selecting "Tools | Macro | Macros..."
3.) Type "Note" as the Macro Name, then click "Create"
4.) The Visual Basic editing window will open. On the left-hand side is a project navigation pane.
Right-click on the top-level item named "Project1" and select "Project1 Properties..."
5.) Change "Project1" to "Business" and click "OK"
6.) In the main code area, you'll see "Sub Note()", followed by "End Sub".
Replace those two lines with the VBA code below, then click Save.
7.) Close the Visual Basic window to return to Outlook
8.) Right-click on the Outlook toolbar and click "Customize..."
9.) Select the "Commands" tab, select the "Macro" from the Categories list,
then drag "Business.Letter" and "Business.Email" to the standard Outlook toolbar and click "Close"
on the "Customize" dialog.
10.) Select a business contact or account, then click the "Business.Email" button.
'//////////////////////////////////////////////////////////////////////////
' Create a New Business E-mail for the selected Business Contact or Account
Sub Email()
' E-MAIL TEMPLATE: If you use an e-mail template, enter its path here
Const emailFilePath = "C:\E-mail Thank You.docx"
OpenCampaign True, emailFilePath
End Sub
' Create a New Business Letter for the selected Business Contact or Account
Sub Letter()
' LETTER TEMPLATE: If you use a letter template, enter its path here
Const letterFilePath = "C:\Thank You.docx"
OpenCampaign False, letterFilePath
End Sub
' Open a new Marketing Campaign with the appropriate settings
Sub OpenCampaign(Email As Boolean, contentFilePath As String)
' Get a reference to the MAPI namespace
Dim objNS As Outlook.NameSpace
Set objNS = Application.GetNamespace("MAPI")
' Get a reference to the currently selected Outlook folder
Dim currentFolder As Outlook.Folder
Set currentFolder = Application.ActiveExplorer.currentFolder
' Make sure at least one item is selected
If Application.ActiveExplorer Is Nothing Then
MsgBox "Please select an item"
Exit Sub
End If
If Application.ActiveExplorer.selection Is Nothing Then
MsgBox "Please select an item"
Exit Sub
End If
' Get a reference to the currently selected item
Dim oItem As Object
Set oItem = Application.ActiveExplorer.selection(1)
If oItem Is Nothing Then
MsgBox "Please select an item"
Exit Sub
End If
' Get the selected item's EntryID
Dim parentEntryID As String
' Verify that this item is located in the Business Contact
' Manager Outlook Store
If 1 = InStr(1, currentFolder.FullFolderPath, _
"\\Business Contact Manager\", vbTextCompare) Then
' Only get the EntryID if this is a Business Contact, Account,
' Opportunity, or Business Project
If oItem.MessageClass = "IPM.Contact.BCM.Contact" Or _
oItem.MessageClass = "IPM.Contact.BCM.Account" Then
parentEntryID = oItem.EntryID
End If
End If
' If we didn't find a valid EntryID, notify the user
If parentEntryID = "" Then
MsgBox "Please select a Business Contact or Account"
Exit Sub
End If
' Get the root BCM folder
Dim olFolders As Outlook.Folders
Dim bcmRootFolder As Outlook.Folder
Set olFolders = objNS.Session.Folders
Set bcmRootFolder = olFolders("Business Contact Manager")
' Locate the Marketing Campaigns folder
Dim marketingCampaignFolder As Outlook.Folder
Set marketingCampaignFolder = _
bcmRootFolder.Folders("Marketing Campaigns")
' Create a new Marketing Campaign
Const MarketingCampaignMessageClass = "IPM.Task.BCM.Campaign"
Dim newMarketingCampaign As Outlook.TaskItem
Set newMarketingCampaign = _
marketingCampaignFolder.Items.Add(MarketingCampaignMessageClass)
' Campaign Code
Dim campaignCode As Outlook.userProperty
Set campaignCode = newMarketingCampaign.ItemProperties("Campaign Code")
If campaignCode Is Nothing Then
Set campaignCode = _
newMarketingCampaign.ItemProperties.Add("Campaign Code", _
olText, False, False)
End If
campaignCode.value = CStr(Now())
' Campaign Type
Dim campaignType As Outlook.userProperty
Set campaignType = _
newMarketingCampaign.ItemProperties("Campaign Type")
If campaignType Is Nothing Then
Set campaignType = _
newMarketingCampaign.ItemProperties.Add("Campaign Type", _
olText, False, False)
End If
' Delivery Method
Dim deliveryMethod As Outlook.userProperty
Set deliveryMethod = _
newMarketingCampaign.ItemProperties("Delivery Method")
If deliveryMethod Is Nothing Then
Set deliveryMethod = _
newMarketingCampaign.ItemProperties.Add("Delivery Method", _
olText, False, False)
End If
' See if this is an e-mail or print letter
Dim title As String
If Email Then
title = "E-mail"
campaignType.value = "E-mail"
deliveryMethod.value = "Word E-Mail Merge"
Else
title = "Letter"
campaignType.value = "Direct Mail Print"
deliveryMethod.value = "Word Mail Merge"
End If
' Marketing Campaign Title
title = title & " to " & oItem.FullName
newMarketingCampaign.subject = title
' Content File
Dim contentFile As Outlook.userProperty
Set contentFile = newMarketingCampaign.ItemProperties("Content File")
If contentFile Is Nothing Then
Set contentFile = _
newMarketingCampaign.ItemProperties.Add("Content File", _
olText, False, False)
End If
contentFile.value = contentFilePath
' FormQuerySelection
Dim formQuerySelection As Outlook.userProperty
Set formQuerySelection = _
newMarketingCampaign.ItemProperties("FormQuerySelection")
If formQuerySelection Is Nothing Then
Set formQuerySelection = _
newMarketingCampaign.ItemProperties.Add("FormQuerySelection", _
olInteger, False, False)
End If
formQuerySelection.value = 9 ' Custom Query
' Recipient List XML
Dim recipientListXML As Outlook.userProperty
Set recipientListXML = _
newMarketingCampaign.ItemProperties("Recipient List XML")
If recipientListXML Is Nothing Then
Set recipientListXML = _
newMarketingCampaign.ItemProperties.Add("Recipient List XML", _
olText, False, False)
End If
' Use these XML properties for BCM Contacts or Accounts
Dim strRecipients
strRecipients = _
"<ArrayOfCampaignRecipient>" & _
" <CampaignRecipient>" & _
" <EntryID>" & oItem.EntryID & "</EntryID>" & _
" </CampaignRecipient>"
' If there is more than one recipient, add the remainder to the list
If Application.ActiveExplorer.selection.Count > 1 Then
Dim i As Integer
For i = 2 To Application.ActiveExplorer.selection.Count
Set oItem = Application.ActiveExplorer.selection(i)
If oItem Is Nothing Then
MsgBox "Please select a Business Contact or Account"
Exit Sub
End If
strRecipients = strRecipients & _
" <CampaignRecipient>" & _
" <EntryID>" & oItem.EntryID & "</EntryID>" & _
" </CampaignRecipient>"
Next
End If
' Close the recipient list
strRecipients = strRecipients & _
"</ArrayOfCampaignRecipient>"
' Use these XML properties for an external list of leads
Dim strExternalRecipients
strExternalRecipients = _
"<ArrayOfCampaignRecipient>" & _
" <CampaignRecipient>" & _
" <FileAs>Ashton, Chris</FileAs>" & _
" <EmailAddress>
[email protected]</EmailAddress>" & _
" </CampaignRecipient>" & _
"</ArrayOfCampaignRecipient>"
' Set the Recipient List XML
recipientListXML.value = strRecipients
' Save the marketing campaign
newMarketingCampaign.Save
' Launch the new marketing campaign
newMarketingCampaign.Display (False)
Set recipientListXML = Nothing
Set formQuerySelection = Nothing
Set deliveryMethod = Nothing
Set contentFile = Nothing
Set campaignType = Nothing
Set campaignCode = Nothing
Set newMarketingCampaign = Nothing
Set marketingCampaignFolder = Nothing
Set bcmfolder = Nothing
Set olFolders = Nothing
Set oItem = Nothing
Set currentFolder = Nothing
Set objNS = Nothing
End Sub
'//////////////////////////////////////////////////////////////////////////
