It is often necessary to create a Business Note for a contact when you are in a hurry. To simplify this process, you can create a button 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 Outlook8.) Right-click on the Outlook toolbar and click "Customize..."9.) Select the "Commands" tab, select the "Macro" from the Categories list, then drag "Business.Note" to the standard Outlook toolbar and click "Close" on the "Customize" dialog.10.) Select a business contact or account, then click the "Business.Note" button.
'////////////////////////////////////////////////////////////////////////' Create a New Business Note for the selected Business ContactSub Note() ' 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
' The parent item's EntryID, if any Dim parentEntryID As String parentEntryID = "" ' Initialize to empty string ' Get a reference to the currently selected item Dim oItem As Object Set oItem = Application.ActiveExplorer.selection(1) If Not (oItem Is Nothing) Then ' 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" Or _ oItem.MessageClass = "IPM.Task.BCM.Opportunity" Or _ oItem.MessageClass = "IPM.Task.BCM.Project" Then parentEntryID = oItem.EntryID End If End If 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 Communication History folder Dim historyFolder As Outlook.Folder Set historyFolder = bcmRootFolder.Folders("Communication History")
' Create a new history item Const BusinessNoteMessageClass = "IPM.Activity.BCM.BusinessNote" Dim newBusinessNote As Outlook.JournalItem Set newBusinessNote = historyFolder.Items.Add(BusinessNoteMessageClass) ' Set the type to Business Note newBusinessNote.Type = "Business Note"
' If we found a valid parent EntryID If parentEntryID <> "" Then ' Link the new Business Note to the selected BCM item Dim parentEntityEntryID As Outlook.userProperty Set parentEntityEntryID = _ newBusinessNote.UserProperties("Parent Entity EntryID") If (parentEntityEntryID Is Nothing) Then Set parentEntityEntryID = _ newBusinessNote.UserProperties.Add("Parent Entity EntryID", _ olText, False, False) End If parentEntityEntryID.value = parentEntryID ' Linking cont'd Dim parentEntryIDs As Outlook.userProperty Set parentEntryIDs = newBusinessNote.UserProperties("Parent Entry IDs") If (parentEntryIDs Is Nothing) Then Set parentEntryIDs = _ newBusinessNote.UserProperties.Add("Parent Entry IDs", _ olKeywords, False, False) End If parentEntryIDs.value = parentEntryID End If ' Display the new, empty business note newBusinessNote.Display (False) Set parentEntryIDs = Nothing Set parentEntityEntryID = Nothing Set newBusinessNote = Nothing Set historyFolder = Nothing Set bcmRootFolder = Nothing Set olFolders = Nothing Set oItem = Nothing Set currentFolder = Nothing Set objNS = Nothing
End Sub'//////////////////////////////////////////////////////////////////////////