As an Act! user I am used to selecting a contact and opening a Word document
with the contact information already in place for the letter I am writing.
This doesn't seem to happen in Outlook Business contact manager. Is this an
available feature or is it an "add-on". I am really trying to transition to
the complete MS Office interface, but am looking for some of the familiar
features of other Contact Management programs - like Act!, for example.

Try going to this link:
http://office.microsoft.com/en-us/as...spx?mode=print

With this you have to have the letter completed and saved in Word. You will
highlight the contact(s) and do a mail merge. I hope this is helpful. You can
use this for printing letters and envelopes.

"SteveInCary" wrote:

> As an Act! user I am used to selecting a contact and opening a Word document
> with the contact information already in place for the letter I am writing.
> This doesn't seem to happen in Outlook Business contact manager. Is this an
> available feature or is it an "add-on". I am really trying to transition to
> the complete MS Office interface, but am looking for some of the familiar
> features of other Contact Management programs - like Act!, for example.

I have also just switched over from Act! and am experiencing the same
challenge. The only way I have figured out how to do this remotely is using
the mail merge commands in Word. However, it is very tedious for one letter
and is better suited for mass mailings. So tedious, it's easier to manually
type in the info and then link the file to the contact during the save
process. Still, I can't believe that something as fundamental as writing a
simple letter is not inlcuded in an otherwise, so far, xlnt product. Any
ideas would be appreciated

"SteveInCary" wrote:

> As an Act! user I am used to selecting a contact and opening a Word document
> with the contact information already in place for the letter I am writing.
> This doesn't seem to happen in Outlook Business contact manager. Is this an
> available feature or is it an "add-on". I am really trying to transition to
> the complete MS Office interface, but am looking for some of the familiar
> features of other Contact Management programs - like Act!, for example.

Craig,

Thanks for this suggestion. We are currently working on a solution for this scenario. In the mean time, I've written a handy
Outlook toolbar button macro to simplify this process. Below are instructions to add the button to your Outlook toolbar and the
actual macro code. Be sure to modify the file paths for your e-mail and letter templates near the top of the macro code. Let me
know if you have any questions.

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>(E-Mail Removed)</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
'//////////////////////////////////////////////////////////////////////////

"Clinton Ford [MSFT]" wrote:

> Craig,
>
> Thanks for this suggestion. We are currently working on a solution for this scenario. In the mean time, I've written a handy
> Outlook toolbar button macro to simplify this process. Below are instructions to add the button to your Outlook toolbar and the
> actual macro code. Be sure to modify the file paths for your e-mail and letter templates near the top of the macro code. Let me
> know if you have any questions.
>
> 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

do you cut and paste the whole vba code or just parts

"Clinton Ford [MSFT]" wrote:

> Craig,
>
> Thanks for this suggestion. We are currently working on a solution for this scenario. In the mean time, I've written a handy
> Outlook toolbar button macro to simplify this process. Below are instructions to add the button to your Outlook toolbar and the
> actual macro code. Be sure to modify the file paths for your e-mail and letter templates near the top of the macro code. Let me
> know if you have any questions.
>
> 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

Well, the Clinton Ford post was in 2007, and as far as I can tell there is
STILL no way to easily create a single letter from an Outlook 2007 or BCM
contact!

"Clinton Ford [MSFT]" wrote:

> Craig,
>
> Thanks for this suggestion. We are currently working on a solution for this scenario. In the mean time, I've written a handy
> Outlook toolbar button macro to simplify this process. Below are instructions to add the button to your Outlook toolbar and the
> actual macro code. Be sure to modify the file paths for your e-mail and letter templates near the top of the macro code. Let me
> know if you have any questions.
>
> 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

If you want to email the person running BCM (which I did) wondering why this
hasn't been addressed since 2007 here's the email
(E-Mail Removed). Maybe they'll pay attention if enough people
email over.

"Deanok" wrote:

> Well, the Clinton Ford post was in 2007, and as far as I can tell there is
> STILL no way to easily create a single letter from an Outlook 2007 or BCM
> contact!
>
> "Clinton Ford [MSFT]" wrote:
>
> > Craig,
> >
> > Thanks for this suggestion. We are currently working on a solution for this scenario. In the mean time, I've written a handy
> > Outlook toolbar button macro to simplify this process. Below are instructions to add the button to your Outlook toolbar and the
> > actual macro code. Be sure to modify the file paths for your e-mail and letter templates near the top of the macro code. Let me
> > know if you have any questions.
> >
> > 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