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 filled out.  Click "Launch" on the Marketing Campaign form to open the letter or e-mail in Word, then click "Mailings | Finish and Merge" in the Word Ribbon.

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 "Email" 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 Email()", 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 selected Business Contact(s) or Contacts
' linked to the selected Account(s), Opportunity(s), or Busines Project(s)
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 selected Business Contact(s) or Contacts
' linked to the selected Account(s), Opportunity(s), or Busines Project(s)
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")

    ' Make sure at least one item is selected
    If Application.ActiveExplorer Is Nothing Then
        MsgBox "Please select at least one item"
        Exit Sub
    End If
    If Application.ActiveExplorer.selection Is Nothing Then
        MsgBox "Please select at least one 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 at least one item"
        Exit Sub
    End If
   
    ' Get a reference to the currently selected Outlook folder
    Dim currentFolder As Outlook.Folder
    Set currentFolder = Application.ActiveExplorer.currentFolder
    If currentFolder Is Nothing Then
        MsgBox "Please select at least one item"
        Exit Sub
    End If
   
    ' Verify that this folder is located in the Business Contact
    ' Manager Outlook Store
    If 1 <> InStr(1, currentFolder.FullFolderPath, _
       "\\Business Contact Manager\", vbTextCompare) Then
        MsgBox "Please select at least one Business Contact, Account, " & _
                "Opportunity, or Business Project"
        Exit Sub
    End If
   
    ' Get the root BCM folder
    Dim olFolders As Outlook.Folders
    Dim bcmRootFolder As Outlook.Folder
    Set olFolders = objNS.Session.Folders
    If olFolders Is Nothing Then
        MsgBox "Unable to get the list of Outlook Session folders"
        Exit Sub
    End If
    Set bcmRootFolder = olFolders("Business Contact Manager")

    ' Get an XML recipient list
    Dim strRecipientXML As String
    strRecipientXML = _
        GetRecipientXML(objNS, _
                        Application.ActiveExplorer.selection, _
                        bcmRootFolder)
    If Trim(strRecipientXML) = "" Then
        MsgBox "Please select at least one Business Contact, Account, " & _
                "Opportunity, or Business Project"
        Exit Sub
    End If
   
    ' 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 to "
        campaignType.value = "E-mail"
        deliveryMethod.value = "Word E-Mail Merge"
    Else
        title = "Letter to "
        campaignType.value = "Direct Mail Print"
        deliveryMethod.value = "Word Mail Merge"
    End If
   
    ' Marketing Campaign Title
    Select Case oItem.MessageClass
        Case "IPM.Contact.BCM.Contact":
            title = title & oItem.FullName
        Case "IPM.Contact.BCM.Account":
            title = title & oItem.FullName
        Case "IPM.Task.BCM.Opportunity":
            title = title & oItem.subject
        Case "IPM.Task.BCM.Project"
            title = title & oItem.subject
    End Select
   
    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
     
    ' Set the Recipient List XML
    recipientListXML.value = strRecipientXML

    ' 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 bcmRootFolder = Nothing
    Set olFolders = Nothing
    Set oItem = Nothing
    Set currentFolder = Nothing
    Set objNS = Nothing
End Sub

' Returns an XML string that specifies the recipients
Function GetRecipientXML(objNS As Outlook.NameSpace, _
                    selectionList As Outlook.selection, _
                    bcmRootFolder As Outlook.Folder) As String
    ' Initialize the retun value to empty string
    GetRecipientXML = ""
    ' Make sure we have a valid parameters
    If objNS Is Nothing Or _
       selectionList Is Nothing Or _
       bcmRootFolder Is Nothing Then
        Exit Function
    End If
   
    ' Build the recipient XML
    Dim strRecipientXML
    strRecipientXML = "<ArrayOfCampaignRecipient>"
       
    ' Add all selected items to the recipient list
    Dim oItem As Object
    Dim astrContactEntryIDs() As String
    ReDim Preserve astrContactEntryIDs(0)
    Dim contactEntryID As Variant
    Dim oParentEntryID As Object
    Dim oParent As Object
   
    For Each oItem In selectionList
        If oItem Is Nothing Then
            MsgBox "Warning: Item not found"
        Else
            ' Only get the EntryID if this is a Business Contact, Account,
            ' Opportunity, or Business Project
            Select Case oItem.MessageClass
                ' Business Contact
                Case "IPM.Contact.BCM.Contact":
                    AddCampaignRecipient astrContactEntryIDs, oItem.EntryID
                ' Account
                Case "IPM.Contact.BCM.Account":
                    AddCampaignRecipient astrContactEntryIDs, oItem.EntryID
                    ' Add Business Contacts associated with this Account
                    AddContactEnryIdsFromAccount objNS, bcmRootFolder, _
                                                 CStr(oItem.EntryID), _
                                                 astrContactEntryIDs
                ' Opportunity
                Case "IPM.Task.BCM.Opportunity":
                    ' Get the parent item
                    Set oParentEntryID = _
                        oItem.UserProperties("Parent Entity EntryID")
                    If oParentEntryID Is Nothing Then
                        MsgBox ("This opportunity is not linked to a " & _
                                "Business Contact or Account")
                    Else
                        AddCampaignRecipient astrContactEntryIDs, _
                                             oParentEntryID.value
                        ' Add Business Contacts associated with Account
                        AddContactEnryIdsFromAccount objNS, _
                                bcmRootFolder, _
                                CStr(oParentEntryID.value), _
                                astrContactEntryIDs
                    End If
                ' Business Project
                Case "IPM.Task.BCM.Project":
                        AddContactEntryIDsFromProject objNS, _
                            bcmRootFolder, oItem, astrContactEntryIDs
                Case Else:
                    ' Invalid BCM type
                    Exit Function
            End Select
        End If
    Next ' Add selected items
   
    ' Add recipients
    If astrContactEntryIDs(0) = "" Then
        ' Unable to find recipient
        Exit Function
    Else
        For Each contactEntryID In astrContactEntryIDs
            If contactEntryID = "" Then
               MsgBox "Warning: Contact not found"
            Else
                strRecipientXML = strRecipientXML & _
                "  <CampaignRecipient>" & _
                "    <EntryID>" & contactEntryID & "</EntryID>" & _
                "  </CampaignRecipient>"
            End If
        Next
    End If
   
    ' Close the recipient list
    strRecipientXML = strRecipientXML & "</ArrayOfCampaignRecipient>"
       
    ' Example XML for an external list of leads
    Dim strExternalRecipientXML
    strExternalRecipientXML = _
        "<ArrayOfCampaignRecipient>" & _
        "  <CampaignRecipient>" & _
        "    <FileAs>Ashton, Chris</FileAs>" & _
        "    <EmailAddress>cashton@contosopharm.com</EmailAddress>" & _
        "  </CampaignRecipient>" & _
        "</ArrayOfCampaignRecipient>"
       
    Set oParent = Nothing
    Set oParentEntryID = Nothing
    Set oItem = Nothing
   
    ' Return the Recipient List XML
    GetRecipientXML = strRecipientXML
End Function

' Returns an array of Business Contact EntryID's for the given Account
Sub AddContactEnryIdsFromAccount(objNS As Outlook.NameSpace, _
                                 bcmRootFolder As Outlook.Folder, _
                                 strAccountID As String, _
                                 astrContactIDs() As String)
    ' Check for a valid BCM root folder and Account EntryID
    If objNS Is Nothing Or _
       bcmRootFolder Is Nothing Or _
       Trim(strAccountID) = "" Then
        Exit Sub
    End If
   
    ' Ensure that this is a BCM Account
    On Error Resume Next
    Dim oItem As Object
    Set oItem = objNS.GetItemFromID(strAccountID)
    If Err.Number <> 0 Then
        Exit Sub
    End If
    If oItem Is Nothing Then
        Exit Sub
    End If
    If oItem.MessageClass <> "IPM.Contact.BCM.Account" Then
        Exit Sub
    End If
    Set oItem = Nothing
    On Error GoTo 0
   
    ' Locate the Business Contacts folder
    Dim businessContacts As Outlook.Folder
    Set businessContacts = _
        bcmRootFolder.Folders("Business Contacts")
    If businessContacts Is Nothing Or _
       businessContacts.Items Is Nothing Then
        Exit Sub
    End If
   
    ' Setup the filter restriction string
    Dim strRestriction As String
    strRestriction = "[Parent Entity EntryID] = '" & strAccountID & "'"
    Dim accountContacts As Outlook.Items
    Set accountContacts = businessContacts.Items.Restrict(strRestriction)
    If accountContacts Is Nothing Then
        Exit Sub
    End If
   
    ' Add each contact to the list of Account contacts
    Dim oContact As Object
    Dim i As Integer
    For Each oContact In accountContacts
        If oContact Is Nothing Then
            MsgBox ("Invalid contact")
        Else
            AddCampaignRecipient astrContactIDs, oContact.EntryID
        End If
    Next
    Set accountContacts = Nothing
    Set businessContacts = Nothing
End Sub

' Get EntryID's for Project's related Business Contacts and Accounts
Sub AddContactEntryIDsFromProject(objNS As Outlook.NameSpace, _
                                  bcmRootFolder As Outlook.Folder, _
                                  oProject As Outlook.TaskItem, _
                                  astrContactIDs() As String)
    ' Check parameters
    If objNS Is Nothing Or _
       bcmRootFolder Is Nothing Or _
       oProject Is Nothing Then
        Exit Sub
    End If
   
    ' Get the project's parent item
    Dim oParentEntryID As Object
    Set oParentEntryID = oProject.UserProperties("Parent Entity EntryID")
    If oParentEntryID Is Nothing Then
        MsgBox ("This project is not linked to a " & _
                "Business Contact or Account")
        Exit Sub
    Else
        AddCampaignRecipient astrContactIDs, oParentEntryID.value
        ' If the parent is an Account, add its contacts too
        AddContactEnryIdsFromAccount objNS, bcmRootFolder, _
                                     oParentEntryID.value, astrContactIDs
       
    End If
   
    ' Get associated contacts
    Dim associatedContacts As Outlook.userProperty
    Set associatedContacts = _
        oProject.UserProperties("Associated Contacts")
    If (associatedContacts Is Nothing) Then
        Exit Sub
    End If
    projectContacts = associatedContacts.value
    Dim projectContactID As Variant
    Dim i As Integer
    On Error Resume Next
    For Each projectContactID In projectContacts
        If IsObject(projectContactID) Then
            MsgBox ("Invalid contact")
        Else
            AddCampaignRecipient astrContactIDs, CStr(projectContactID)
            ' If the related contact is an Account, add its contacts too
            AddContactEnryIdsFromAccount objNS, bcmRootFolder, _
                                         CStr(projectContactID), _
                                         astrContactIDs
        End If
    Next
    On Error GoTo 0
    Set associatedContacts = Nothing
    Set oParentEntryID = Nothing
End Sub

' Add a unique campaign recipient to the given array
Sub AddCampaignRecipient(ByRef astrRecipientIDs() As String, _
                        recipientID As String)
    Dim arrFilter() As String
    ' Check to see if this is a duplicate recipient
    arrFilter = Filter(astrRecipientIDs, recipientID, True, vbTextCompare)
    If UBound(arrFilter) < 0 Then
        Dim i As Integer
        i = UBound(astrRecipientIDs)
        ' See if we need to grow the array length
        If i > 0 Or astrRecipientIDs(0) <> "" Then
            i = i + 1
            ReDim Preserve astrRecipientIDs(0 To i)
        End If
        ' Add this recipient to our list
        astrRecipientIDs(i) = recipientID
    End If
End Sub
'//////////////////////////////////////////////////////////////////////////