Automatically Create Leads from Web Forms

[Clinton Ford [MSFT]]

Prospective customers often visit a company's web site before doing business.
Most web sites display product and service details. From the web site,
visitors can request additional product information, explain a custom need,
or report an issue. When the user submits a request, the web server can
generate an e-mail message to the sales representative with the sender's name
and e-mail address on the From line. The e-mail body can display the
submitted information on consecutive lines as shown below:

Name: Clinton Ford
E-mail: (e-mail address removed)
Company: Contoso
Address: 862 Contoso St., Ste. 105
City:Redmond
State:WA
Zip Code: 98052
Phone: 425-555-1212
Source: Web
Comments: I'd like to meet on Wed. to discuss a new project

Wouldn't it be nice if you could automatically create Leads and
Opportunities in Business Contact Manager from these e-mail requests? Below
is an Outlook macro to help you do this.

First, test the macro on a sample e-mail form from your web server by
creating 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 script 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.Lead" and "Business.Opportunity" to the standard Outlook
toolbar and click "Close" on the "Customize" dialog.
10.) Select an e-mail message, then click the "Business.Lead" button.

You can then automate the process with an Outlook Rule:
1.) Tools | Rules and Alerts... | New Rule
2.) Check Messages when they arrive | Next
3.) Select criteria (e.g. With specific words in the subject or body) |
Next
4.) run a script | Select "Business.LeadRule" or
"Business.OpportunityRule", then click "OK" | Next
5.) Finish

A couple of additional notes:
- You can also populate BCM custom fields. For example, I customized the
Business Contact form by adding a text field named "Interested In"
- I opened the Business Contact form, selected the "Source" drop-down list
and clicked "Edit this List..." to add "Word of Mouth" as a Source of Lead
- I created an Outlook rule that runs the "Business.LeadRule" script when an
e-mail arrives with "Web Contact Form" in the subject
- Comments are limited to a single line. They cannot contain carriage
returns or newlines
- The full list of Outlook Contact ItemProperties can be found at:
http://msdn2.microsoft.com/en-us/library/bb208315.aspx
- The full list of Business Contact UserProperties can be found at:
http://msdn2.microsoft.com/en-us/library/aa431892.aspx

You can populate either Lead or Opportunity fields from the e-mail message.
To add a new field:

1.) Increment the number of properties (currently 12) in the MapProperties()
function.
2.) Copy and paste an existing set of property attributes
3.) Increment the index on each line to match the number from step 1.
4.) Change the attributes as needed to populate your Opportunity or Lead
fields.

(I'll post the VBA Macro in a reply to this post due to the macro length)

 

[Clinton Ford [MSFT]]

'////////////////////////////////////////////////////////////////////////
Const conDelimeter = ":" ' Separates property names from values
Const conPrefix = "" ' Text that should be ignored at top of mail
Const conPostfix = "" ' Text that should be ignored at end of mail

' This function maps e-mail name-value pairs to BCM properties
Function MapProperties() As Variant()
' Change the first number to match the number of properties
' The second number is the number of property attributes
Dim arrProperties(12, 5) As Variant

' 1.) Email
arrProperties(1, 0) = "E-mail" ' Web Form Property Name
arrProperties(1, 1) = "Email1Address" ' Outlook Property Name
arrProperties(1, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(1, 3) = olText ' Outlook data type
arrProperties(1, 4) = True ' Outlook Item Property (or User Prop)?

' 2.) Company
arrProperties(2, 0) = "Company" ' Web Form Property Name
arrProperties(2, 1) = "CompanyName" ' Outlook Property Name
arrProperties(2, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(2, 3) = olText ' Outlook data type
arrProperties(2, 4) = True ' Outlook Item Property (or User Prop)?

' 3.) Industry
arrProperties(3, 0) = "Industry" ' Web Form Property Name
arrProperties(3, 1) = "Industry" ' Outlook Property Name
arrProperties(3, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(3, 3) = olText ' Outlook data type
arrProperties(3, 4) = False ' Outlook Item Property (or User Prop)?

' 4.) FullName
arrProperties(4, 0) = "Name" ' Web Form Property Name
arrProperties(4, 1) = "FullName" ' Outlook Property Name
arrProperties(4, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(4, 3) = olText ' Outlook data type
arrProperties(4, 4) = True ' Outlook Item Property (or User Prop)?

' 5.) BusinessAddressStreet
arrProperties(5, 0) = "Address" ' Web Form Property Name
arrProperties(5, 1) = "BusinessAddressStreet" ' Outlook Property Name
arrProperties(5, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(5, 3) = olText ' Outlook data type
arrProperties(5, 4) = True ' Outlook Item Property (or User Prop)?

' 6.) BusinessAddressCity
arrProperties(6, 0) = "City" ' Web Form Property Name
arrProperties(6, 1) = "BusinessAddressCity" ' Outlook Property Name
arrProperties(6, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(6, 3) = olText ' Outlook data type
arrProperties(6, 4) = True ' Outlook Item Property (or User Prop)?

' 7.) BusinessAddressState
arrProperties(7, 0) = "State" ' Web Form Property Name
arrProperties(7, 1) = "BusinessAddressState" ' Outlook Property Name
arrProperties(7, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(7, 3) = olText ' Outlook data type
arrProperties(7, 4) = True ' Outlook Item Property (or User Prop)?

' 8.) BusinessAddressPostalCode
arrProperties(8, 0) = "Zip Code" ' Web Form Prop Name
arrProperties(8, 1) = "BusinessAddressPostalCode" ' Outlook Prop Name
arrProperties(8, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(8, 3) = olText ' Outlook data type
arrProperties(8, 4) = True ' Outlook Item Property (or User Prop)?

' 9.) BusinessPhone
arrProperties(9, 0) = "Phone" ' Web Form Property Name
arrProperties(9, 1) = "BusinessTelephoneNumber" 'Outlook Property Name
arrProperties(9, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(9, 3) = olText ' Outlook data type
arrProperties(9, 4) = True ' Outlook Item Property (or User Prop)?

' 10.) InterestedIn
arrProperties(10, 0) = "Interest" ' Web Form Property Name
arrProperties(10, 1) = "Interested In" ' Outlook Property Name
arrProperties(10, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(10, 3) = olText ' Outlook data type
arrProperties(10, 4) = False ' Outlook Item Property (or User Prop)?

' 11.) Source of Lead
arrProperties(11, 0) = "Source" ' Web Form Property Name
arrProperties(11, 1) = "Source of Lead" ' Outlook Property Name
arrProperties(11, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(11, 3) = olText ' Outlook data type
arrProperties(11, 4) = False ' Outlook Item Property (or User Prop)?

' 12.) Comments
arrProperties(12, 0) = "Comments" ' Web Form Property Name
arrProperties(12, 1) = "Body" ' Outlook Property Name
arrProperties(12, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(12, 3) = olText ' Outlook data type
arrProperties(12, 4) = True ' Outlook Item Property (or User Prop)?

' Return the array
MapProperties = arrProperties
End Function

' Automatically create a Lead for inbound mail items
Sub LeadRule(oMailItem As Outlook.MailItem)
' Make sure we have a valid mail item
If oMailItem Is Nothing Then
Exit Sub
End If

' Get a reference to the MAPI namespace
Dim objNS As Outlook.NameSpace
Set objNS = Application.GetNamespace("MAPI")

' 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 locate BCM root folder"
Exit Sub
End If

Set bcmRootFolder = olFolders("Business Contact Manager")

If bcmRootFolder Is Nothing Then
MsgBox "Unable to get Business Contacts folder"
Exit Sub
End If

' Create a Lead from this e-mail message
Call GetLinkedContact(bcmRootFolder, oMailItem, True)
End Sub

' Automatically create a Lead for inbound mail items
Sub OpportunityRule(oMailItem As Outlook.MailItem)
' Make sure we have a valid mail item
If oMailItem Is Nothing Then
Exit Sub
End If

' Get a reference to the MAPI namespace
Dim objNS As Outlook.NameSpace
Set objNS = Application.GetNamespace("MAPI")

' 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 locate BCM root folder"
Exit Sub
End If
Set bcmRootFolder = olFolders("Business Contact Manager")
If bcmRootFolder Is Nothing Then
MsgBox "Could not locate the 'Business Contact Manager' folder"
Exit Sub
End If
If oMailItem Is Nothing Then
MsgBox "MailItem is not set"
Exit Sub
End If

Dim oParent As Outlook.ContactItem
Set oParent = GetOpportunityParent(bcmRootFolder, _
oMailItem, True)
' If we found a Business Contact or Account,
' save its EntryID and Display Name
If oParent Is Nothing Then
MsgBox ("Unable to create or find Opportunity parent")
Else
' Create an Opportunity and link it to the Lead,
' Business Contact, or Account
Dim newOpportunity As Outlook.TaskItem
Set newOpportunity = CreateOpportunity(oParent, _
oMailItem, _
bcmRootFolder, True)
End If
End Sub

' Create a New Opportunity from the selected Business Contact or E-mail
Sub Opportunity()
' 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 an Outlook folder"
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

' 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")
If bcmRootFolder Is Nothing Then
MsgBox "Unable to locate the 'Business Contact Manager' folder"
Exit Sub
End If

' The parent item's EntryID
Dim parentEntryID As String
parentEntryID = "" ' Initialize to empty string
' The parent item's display name
Dim parentDisplayName As String
parentDisplayName = "" ' Initialize to empty string

' Get a reference to the currently selected item
Dim oItem As Object
Dim oParent As Outlook.ContactItem
Set oParent = Nothing
If Not (Application.ActiveExplorer.Selection Is Nothing) Then
If Application.ActiveExplorer.Selection.Count > 0 Then
Set oItem = Application.ActiveExplorer.Selection(1)
End If
End If
If Not (oItem Is Nothing) Then
Set oParent = GetOpportunityParent(bcmRootFolder, _
oItem, True)
' If we found a Business Contact or Account,
' save its EntryID and Display Name
If Not (oParent Is Nothing) Then
parentEntryID = oParent.EntryID
parentDisplayName = oParent.FullName
End If
End If
' Create an Opportunity and link it to the Lead,
' Business Contact, or Account
Dim newOpportunity As Outlook.TaskItem
Dim oMailItem As Outlook.MailItem
Set oMailItem = Nothing
' If this is an e-mail message, look for a related contact/account
If oItem.MessageClass = "IPM.Note" Then
Set oMailItem = oItem
End If
Set newOpportunity = CreateOpportunity(oParent, _
oMailItem, _
bcmRootFolder, _
False)
If newOpportunity Is Nothing Then
MsgBox "Unable to create Opportunity"
Else
' Display the new Opportunity
newOpportunity.Display (False)
End If
End Sub

' Returns the item if it is a Business Contact or Account,
' otherwise creates a new Lead
Function GetOpportunityParent(bcmRootFolder As Outlook.Folder, _
oItem As Object, _
bSave As Boolean) As Outlook.ContactItem
Set GetOpportunityParent = Nothing
If oItem Is Nothing Then
Exit Function
End If
Dim oContactItem As Outlook.ContactItem
Set oContactItem = Nothing
' Only get EntryID if Business Contact or Account
If oItem.MessageClass = "IPM.Contact.BCM.Contact" Or _
oItem.MessageClass = "IPM.Contact.BCM.Account" Then
' The Contact/Account is the Opportunity parent
Set oContactItem = oItem
Else
Set oContactItem = GetLinkedContact(bcmRootFolder, oItem, bSave)
End If
' Return the parent item
Set GetOpportunityParent = oContactItem
End Function

' Retrieves the existing Business Contact or Account,
' otherwise creates a new Lead
Function GetLinkedContact(bcmRootFolder As Outlook.Folder, _
oItem As Object, _
bSave As Boolean) As Outlook.ContactItem
Set GetLinkedContact = Nothing
If oItem Is Nothing Then
Exit Function
End If
Dim oContactItem As Outlook.ContactItem
Set oContactItem = Nothing
Dim oMailItem As Outlook.MailItem
Set oMailItem = Nothing
' If this is an e-mail message, look for the linked contact/account
If oItem.MessageClass = "IPM.Note" Then
' Locate the corresponding Business Contact or Account
Set oMailItem = oItem
Dim strEmailAddress As String
strEmailAddress = oMailItem.SenderEmailAddress
Set oContactItem = GetContactFromEmail(bcmRootFolder, _
"Business Contacts", strEmailAddress)
' If no matching Business Contact was found,
' look for a matching Account
If oContactItem Is Nothing Then
Set oContactItem = GetContactFromEmail _
(bcmRootFolder, "Accounts", strEmailAddress)
End If
End If
' If neither exists, create a new Lead
If oContactItem Is Nothing Then
Set oContactItem = CreateLeadFromEmail _
(bcmRootFolder, oMailItem, bSave)
' Save the new Lead as needed to generate an EntryID
If Not (oContactItem Is Nothing) And bSave Then
oContactItem.Save
End If
End If
' Return the parent item
Set GetLinkedContact = oContactItem
End Function

' Looks up a Business Contact or Account by e-mail address
Function GetContactFromEmail(bcmRootFolder As Outlook.Folder, _
bcmSubFolder As String, _
strEmailAddress As String) _
As Outlook.ContactItem
Set GetContactFromEmail = Nothing
If bcmRootFolder Is Nothing Or bcmSubFolder = "" Or _
strEmailAddress = "" Then
MsgBox "Unable to Get Contact From Email - missing parameter(s)"
Exit Function
End If
' Locate the Business Contacts folder
Dim oContactsFolder As Outlook.Folder
Set oContactsFolder = _
bcmRootFolder.Folders(bcmSubFolder)
If oContactsFolder Is Nothing Or _
oContactsFolder.Items Is Nothing Then
MsgBox "Unable to get the BCM sub-folder"
Exit Function
End If

' Setup the filter restriction string
Dim strRestriction As String
strRestriction = "[Email1Address] = '" & strEmailAddress & "'"
Dim contacts As Outlook.Items
Set contacts = oContactsFolder.Items.Restrict(strRestriction)
If contacts Is Nothing Then
Exit Function
End If

' Add each contact to the list of Account contacts
Dim oContact As Object
Dim i As Integer
For Each oContact In contacts
' Return the first valid contact item
If Not (oContact Is Nothing) Then
Exit For
End If
Next
Set GetContactFromEmail = oContact
Set contacts = Nothing
Set oContactsFolder = Nothing
End Function

' Creates and displays a Lead. If an e-mail message is selected, the Lead
' fields are populated using the sender's name and e-mail address and
' the e-mail contents are used to populate the Lead fields
Sub Lead()
Dim oLead As Outlook.ContactItem
Set oLead = Nothing

' 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

' 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")
Dim BcmContactItem As Outlook.ContactItem

' Get a reference to the currently selected item
Dim oItem As Object
' Make sure at least one item is selected
If Not (Application.ActiveExplorer Is Nothing) Then
If Not (Application.ActiveExplorer.Selection Is Nothing) Then
If Application.ActiveExplorer.Selection.Count > 0 Then
Set oItem = Application.ActiveExplorer.Selection(1)
End If
End If
End If

' Get existing Lead or create a new one
Set oLead = GetLinkedContact(bcmRootFolder, oItem, False)

' If we found or created a Lead, display it
If Not (oLead Is Nothing) Then
oLead.Display (False)
End If
End Sub

' Creates a Lead from an e-mail message
Function CreateLeadFromEmail(bcmRootFolder As Outlook.Folder, _
oMailItem As Outlook.MailItem, _
bSave As Boolean) _
As Outlook.ContactItem
Set CreateLeadFromEmail = Nothing
Dim oLead As Outlook.ContactItem
Set oLead = Nothing
' Locate the Contacts folder
Dim oContactsFolder As Outlook.Folder
Set oContactsFolder = _
bcmRootFolder.Folders("Business Contacts")
If oContactsFolder Is Nothing Then
MsgBox "Unable to get Business Contacts folder"
Exit Function
End If
' Create a new Lead
Const ContactMessageClass = "IPM.Contact.BCM.Contact"
Dim newLead As Outlook.ContactItem
Set newLead = _
oContactsFolder.Items.Add(ContactMessageClass)
If newLead Is Nothing Then
MsgBox "Unable to Create New Lead from Email"
Exit Function
End If
' Set the Lead flag
Dim oLeadProp As Outlook.UserProperty
Set oLeadProp = _
newLead.UserProperties("Lead")
If (oLeadProp Is Nothing) Then
Set oLeadProp = _
newLead.UserProperties.Add("Lead", _
Outlook.olYesNo, False, False)
End If
oLeadProp.Value = True

' See if we have an e-mail message
If oMailItem Is Nothing Then
If bSave Then
oLead.Save
End If
Else
newLead.FullName = oMailItem.SenderName
newLead.Email1Address = oMailItem.SenderEmailAddress
' Parse other lead information from the web form mail
Call ParseWebForm(oMailItem, bSave, newLead, Nothing)
End If
Set CreateLeadFromEmail = newLead
End Function

' Create an Opportunity and link it to the parent item
Function CreateOpportunity(oParentItem As Outlook.ContactItem, _
oMailItem As Outlook.MailItem, _
bcmRootFolder As Outlook.Folder, _
bSave As Boolean) _
As Outlook.TaskItem
' Initialize result to Nothing
Set CreateOpportunity = Nothing

' Locate the Opportunities folder
Dim opportunitiesFolder As Outlook.Folder
Set opportunitiesFolder = _
bcmRootFolder.Folders("Opportunities")

If opportunitiesFolder Is Nothing Then
MsgBox "Unable to get Opportunities folder"
Exit Function
End If

' Create a new Opportunity
Const OpportunityMessageClass = "IPM.Task.BCM.Opportunity"
Dim oNewOpportunity As Outlook.TaskItem
Set oNewOpportunity = _
opportunitiesFolder.Items.Add(OpportunityMessageClass)

If oNewOpportunity Is Nothing Then
MsgBox "Unable to create opportunity"
Exit Function
End If

' Set the opportunity title
If Not (oMailItem Is Nothing) Then
oNewOpportunity.Subject = Trim(oMailItem.Subject)
End If

' Store the parent EntryID and Display Name
If Not (oParentItem Is Nothing) Then
Dim strParentEntryID As String
Dim strParentDisplayName As String
strParentEntryID = oParentItem.EntryID
strParentDisplayName = oParentItem.FullName
End If

' Verify that we have these parameters
If strParentEntryID <> "" And _
strParentDisplayName <> "" Then

' Link the new Opportunity to the selected BCM item
Dim parentEntityEntryID As Outlook.UserProperty
Set parentEntityEntryID = _
oNewOpportunity.UserProperties("Parent Entity EntryID")
If (parentEntityEntryID Is Nothing) Then
Set parentEntityEntryID = _
oNewOpportunity.UserProperties.Add( _
"Parent Entity EntryID", _
olText, False, False)
End If
parentEntityEntryID.Value = strParentEntryID

' Parent Entry ID
Dim parentEntryID As Outlook.UserProperty
Set parentEntryID = _
oNewOpportunity.UserProperties("Parent Entry ID")
If (parentEntryID Is Nothing) Then
Set parentEntryID = _
oNewOpportunity.UserProperties.Add("Parent Entry ID", _
olKeywords, False, False)
End If
parentEntryID.Value = strParentEntryID

' Parent Display Name
Dim parentDisplayName As Outlook.UserProperty
Set parentDisplayName = _
oNewOpportunity.UserProperties("ParentDisplayName")
If (parentDisplayName Is Nothing) Then
Set parentDisplayName = _
oNewOpportunity.UserProperties.Add("ParentDisplayName", _
olText, False, False)
End If
parentDisplayName.Value = strParentDisplayName
End If

' Parse Opportunity information from the web form mail
Call ParseWebForm(oMailItem, bSave, Nothing, oNewOpportunity)

' Save the new Opportunity as needed
If bSave Then
oNewOpportunity.Save
End If

' Return the new Opportunity
Set CreateOpportunity = oNewOpportunity
End Function

Sub ParseWebForm(oMailItem As Outlook.MailItem, _
bSave As Boolean, _
Optional oParentItem As Outlook.ContactItem, _
Optional oOpportunity As Outlook.TaskItem)
' Get the mail body
Dim strMailBody As String
strMailBody = oMailItem.Body

' Create a Regular Expression Object
Dim RegX As Object
Set RegX = CreateObject("vbscript.regexp")
If RegX Is Nothing Then
MsgBox "Unable to create Regular Expression object"
Exit Sub
End If
' Remove any prefix
If conPrefix <> "" Then
RegX.Pattern = "(?:[`~!@#$%^&*()-_+=\[\]{}<>,.\/?\w\s])*?" & _
conPrefix
RegX.IgnoreCase = True
RegX.Global = False
strMailBody = RegX.Replace(strMailBody, "")
End If
' Remove any postfix
If conPostfix <> "" Then
RegX.Pattern = _
conPostfix & "(?:[`~!@#$%^&*()-_+=\[\]{}<>,.\/?\w\s])+"
RegX.IgnoreCase = True
RegX.Global = False
strMailBody = RegX.Replace(strMailBody, "")
End If

' Validate the delimeter character for use in our regular expression
Dim strDelimeter As String
strDelimeter = Right(conDelimeter, 1)
RegX.Pattern = "[\?\*\+\.\|\{\}\\\[\]\(\)]"
RegX.IgnoreCase = True
RegX.Global = False
Dim colValues As Variant
Set colValues = RegX.Execute(strDelimeter)
If colValues.Count > 0 Then
strDelimeter = "\" & strDelimeter
End If

' Find name-value pairs
RegX.Pattern = "(.*)" & strDelimeter & "[ \t]*(.*)"
RegX.IgnoreCase = True
RegX.Global = True
Set colValues = RegX.Execute(strMailBody)
If colValues Is Nothing Then
Exit Sub
End If

Dim arrProperties() As Variant
arrProperties = MapProperties()

' Make sure we have at least 5 attributes per property
If UBound(arrProperties, 2) < 4 Then
MsgBox ("Missing some property attributes")
Exit Sub
End If

Dim i As Integer
Dim strFormPropName As String
Dim strOLPropName As String
Dim strValue As String
Dim itemProp As Outlook.ItemProperty
Dim userProp As Outlook.UserProperty

' Get and save properties
For Each Value In colValues
' Retrieve property name
RegX.Pattern = strDelimeter & "[ \t]*(.*)"
strFormPropName = RegX.Replace(CStr(Value), "")

' Retrieve property value
RegX.Pattern = "(.*)" & strDelimeter & "[ \t]*"
strValue = RegX.Replace(CStr(Value), "")
' Remove any trailing carriage returns
strValue = Replace(strValue, Chr(13), "")
' Remove any trailing form feeds
strValue = Replace(strValue, Chr(10), "")
' Get the property attributes
i = GetPropertyIndex(arrProperties, strFormPropName)
' Save this property value if it has a value and attributes
If strValue <> "" And _
i >= 0 Then
' Get the Outlook propertyName
strOLPropName = arrProperties(i, 1)
' Lead Property and we have a parent
If arrProperties(i, 2) And Not (oParentItem Is Nothing) Then
' ItemProperty
If arrProperties(i, 4) Then
Set itemProp = _
oParentItem.ItemProperties(strOLPropName)
If (itemProp Is Nothing) Then
Set itemProp = _
oParentItem.ItemProperties.Add(strOLPropName, _
arrProperties(i, 3), _
False, False)
End If
SetProperty itemProp, CInt(arrProperties(i, 3)), _
strValue
' UserProperty
Else
Set userProp = _
oParentItem.UserProperties(strOLPropName)
If (userProp Is Nothing) Then
Set userProp = _
oParentItem.UserProperties.Add(strOLPropName, _
arrProperties(i, 3), _
False, False)
End If
SetProperty userProp, CInt(arrProperties(i, 3)), _
strValue
End If
' Opportunity Property and we have an opportunity
ElseIf Not arrProperties(i, 2) And _
Not (oOpportunity Is Nothing) Then
' ItemProperty
If arrProperties(i, 4) Then
Set itemProp = _
oOpportunity.ItemProperties(strOLPropName)
If (itemProp Is Nothing) Then
Set itemProp = _
oParentItem.ItemProperties.Add(strOLPropName, _
arrProperties(i, 3), _
False, False)
End If
SetProperty itemProp, CInt(arrProperties(i, 3)), _
strValue
' UserProperty
Else
Set userProp = _
oOpportunity.UserProperties(strOLPropName)
If (userProp Is Nothing) Then
Set userProp = _
oOpportunity.UserProperties.Add(strOLPropName, _
arrProperties(i, 3), _
False, False)
End If
' Save the property
SetProperty userProp, CInt(arrProperties(i, 3)), _
strValue
End If
End If
End If
Next
If Not (oParentItem Is Nothing) And bSave Then
' Save any updates to the parent item
oParentItem.Save
End If
End Sub

' Returns the property attributes for a given property name
Function GetPropertyIndex(arrProperties() As Variant, strPropertyName) _
As Integer
Dim i As Integer
For i = LBound(arrProperties, 1) To UBound(arrProperties, 1)
If strPropertyName = arrProperties(i, 0) Then
GetPropertyIndex = i
Exit Function
End If
Next
GetPropertyIndex = -1
End Function

' Set the Outlook property value
Sub SetProperty(prop As Object, iType As Integer, strValue As String)
On Error Resume Next
If olYesNo = iType Then
If InStr(1, strValue, "Yes", vbTextCompare) Or _
InStr(1, strValue, "True", vbTextCompare) Then
prop.Value = True
Else
prop.Value = False
End If
ElseIf olNumber = iType Or _
olInteger = iType Then
prop.Value = CInt(strValue)
Else
prop.Value = strValue
End If
If Err.Number <> 0 Then
Dim strPropName As String
strPropName = prop.Name
MsgBox "Unable to set property '" & strPropName & _
"' to value '" & strValue & "'. Please check the property " & _
"type, value, and if it is a UserProperty or ItemProperty."
End If
On Error GoTo 0
End Sub
'////////////////////////////////////////////////////////////////////////

 

[Lon Orenstein]

YOU DA' MAN, Clinton!!!

Thanks very much for this -- I'll get it installed and make it work asap.
This is a huge addition to the BCM community to help us link data from our
website forms into BCM.

Lon

___________________________________________________________
Lon Orenstein
pinpointtools, llc
(e-mail address removed)
Author of Outlook 2007 Business Contact Manager For Dummies
Author of the eBook: Moving from ACT! to Business Contact Manager
800.238.0560 x6104 Toll Free (U.S. only) +1 214.905.0401 x6104
www.pinpointtools.com

'////////////////////////////////////////////////////////////////////////
Const conDelimeter = ":" ' Separates property names from values
Const conPrefix = "" ' Text that should be ignored at top of mail
Const conPostfix = "" ' Text that should be ignored at end of mail

' This function maps e-mail name-value pairs to BCM properties
Function MapProperties() As Variant()
' Change the first number to match the number of properties
' The second number is the number of property attributes
Dim arrProperties(12, 5) As Variant

' 1.) Email
arrProperties(1, 0) = "E-mail" ' Web Form Property Name
arrProperties(1, 1) = "Email1Address" ' Outlook Property Name
arrProperties(1, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(1, 3) = olText ' Outlook data type
arrProperties(1, 4) = True ' Outlook Item Property (or User Prop)?

' 2.) Company
arrProperties(2, 0) = "Company" ' Web Form Property Name
arrProperties(2, 1) = "CompanyName" ' Outlook Property Name
arrProperties(2, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(2, 3) = olText ' Outlook data type
arrProperties(2, 4) = True ' Outlook Item Property (or User Prop)?

' 3.) Industry
arrProperties(3, 0) = "Industry" ' Web Form Property Name
arrProperties(3, 1) = "Industry" ' Outlook Property Name
arrProperties(3, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(3, 3) = olText ' Outlook data type
arrProperties(3, 4) = False ' Outlook Item Property (or User Prop)?

' 4.) FullName
arrProperties(4, 0) = "Name" ' Web Form Property Name
arrProperties(4, 1) = "FullName" ' Outlook Property Name
arrProperties(4, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(4, 3) = olText ' Outlook data type
arrProperties(4, 4) = True ' Outlook Item Property (or User Prop)?

' 5.) BusinessAddressStreet
arrProperties(5, 0) = "Address" ' Web Form Property Name
arrProperties(5, 1) = "BusinessAddressStreet" ' Outlook Property Name
arrProperties(5, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(5, 3) = olText ' Outlook data type
arrProperties(5, 4) = True ' Outlook Item Property (or User Prop)?

' 6.) BusinessAddressCity
arrProperties(6, 0) = "City" ' Web Form Property Name
arrProperties(6, 1) = "BusinessAddressCity" ' Outlook Property Name
arrProperties(6, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(6, 3) = olText ' Outlook data type
arrProperties(6, 4) = True ' Outlook Item Property (or User Prop)?

' 7.) BusinessAddressState
arrProperties(7, 0) = "State" ' Web Form Property Name
arrProperties(7, 1) = "BusinessAddressState" ' Outlook Property Name
arrProperties(7, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(7, 3) = olText ' Outlook data type
arrProperties(7, 4) = True ' Outlook Item Property (or User Prop)?

' 8.) BusinessAddressPostalCode
arrProperties(8, 0) = "Zip Code" ' Web Form Prop Name
arrProperties(8, 1) = "BusinessAddressPostalCode" ' Outlook Prop Name
arrProperties(8, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(8, 3) = olText ' Outlook data type
arrProperties(8, 4) = True ' Outlook Item Property (or User Prop)?

' 9.) BusinessPhone
arrProperties(9, 0) = "Phone" ' Web Form Property Name
arrProperties(9, 1) = "BusinessTelephoneNumber" 'Outlook Property Name
arrProperties(9, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(9, 3) = olText ' Outlook data type
arrProperties(9, 4) = True ' Outlook Item Property (or User Prop)?

' 10.) InterestedIn
arrProperties(10, 0) = "Interest" ' Web Form Property Name
arrProperties(10, 1) = "Interested In" ' Outlook Property Name
arrProperties(10, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(10, 3) = olText ' Outlook data type
arrProperties(10, 4) = False ' Outlook Item Property (or User Prop)?

' 11.) Source of Lead
arrProperties(11, 0) = "Source" ' Web Form Property Name
arrProperties(11, 1) = "Source of Lead" ' Outlook Property Name
arrProperties(11, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(11, 3) = olText ' Outlook data type
arrProperties(11, 4) = False ' Outlook Item Property (or User Prop)?

' 12.) Comments
arrProperties(12, 0) = "Comments" ' Web Form Property Name
arrProperties(12, 1) = "Body" ' Outlook Property Name
arrProperties(12, 2) = True ' Lead property (or Opportunity prop)?
arrProperties(12, 3) = olText ' Outlook data type
arrProperties(12, 4) = True ' Outlook Item Property (or User Prop)?

' Return the array
MapProperties = arrProperties
End Function

' Automatically create a Lead for inbound mail items
Sub LeadRule(oMailItem As Outlook.MailItem)
' Make sure we have a valid mail item
If oMailItem Is Nothing Then
Exit Sub
End If

' Get a reference to the MAPI namespace
Dim objNS As Outlook.NameSpace
Set objNS = Application.GetNamespace("MAPI")

' 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 locate BCM root folder"
Exit Sub
End If

Set bcmRootFolder = olFolders("Business Contact Manager")

If bcmRootFolder Is Nothing Then
MsgBox "Unable to get Business Contacts folder"
Exit Sub
End If

' Create a Lead from this e-mail message
Call GetLinkedContact(bcmRootFolder, oMailItem, True)
End Sub

' Automatically create a Lead for inbound mail items
Sub OpportunityRule(oMailItem As Outlook.MailItem)
' Make sure we have a valid mail item
If oMailItem Is Nothing Then
Exit Sub
End If

' Get a reference to the MAPI namespace
Dim objNS As Outlook.NameSpace
Set objNS = Application.GetNamespace("MAPI")

' 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 locate BCM root folder"
Exit Sub
End If
Set bcmRootFolder = olFolders("Business Contact Manager")
If bcmRootFolder Is Nothing Then
MsgBox "Could not locate the 'Business Contact Manager' folder"
Exit Sub
End If
If oMailItem Is Nothing Then
MsgBox "MailItem is not set"
Exit Sub
End If

Dim oParent As Outlook.ContactItem
Set oParent = GetOpportunityParent(bcmRootFolder, _
oMailItem, True)
' If we found a Business Contact or Account,
' save its EntryID and Display Name
If oParent Is Nothing Then
MsgBox ("Unable to create or find Opportunity parent")
Else
' Create an Opportunity and link it to the Lead,
' Business Contact, or Account
Dim newOpportunity As Outlook.TaskItem
Set newOpportunity = CreateOpportunity(oParent, _
oMailItem, _
bcmRootFolder, True)
End If
End Sub

' Create a New Opportunity from the selected Business Contact or E-mail
Sub Opportunity()
' 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 an Outlook folder"
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

' 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")
If bcmRootFolder Is Nothing Then
MsgBox "Unable to locate the 'Business Contact Manager' folder"
Exit Sub
End If

' The parent item's EntryID
Dim parentEntryID As String
parentEntryID = "" ' Initialize to empty string
' The parent item's display name
Dim parentDisplayName As String
parentDisplayName = "" ' Initialize to empty string

' Get a reference to the currently selected item
Dim oItem As Object
Dim oParent As Outlook.ContactItem
Set oParent = Nothing
If Not (Application.ActiveExplorer.Selection Is Nothing) Then
If Application.ActiveExplorer.Selection.Count > 0 Then
Set oItem = Application.ActiveExplorer.Selection(1)
End If
End If
If Not (oItem Is Nothing) Then
Set oParent = GetOpportunityParent(bcmRootFolder, _
oItem, True)
' If we found a Business Contact or Account,
' save its EntryID and Display Name
If Not (oParent Is Nothing) Then
parentEntryID = oParent.EntryID
parentDisplayName = oParent.FullName
End If
End If
' Create an Opportunity and link it to the Lead,
' Business Contact, or Account
Dim newOpportunity As Outlook.TaskItem
Dim oMailItem As Outlook.MailItem
Set oMailItem = Nothing
' If this is an e-mail message, look for a related contact/account
If oItem.MessageClass = "IPM.Note" Then
Set oMailItem = oItem
End If
Set newOpportunity = CreateOpportunity(oParent, _
oMailItem, _
bcmRootFolder, _
False)
If newOpportunity Is Nothing Then
MsgBox "Unable to create Opportunity"
Else
' Display the new Opportunity
newOpportunity.Display (False)
End If
End Sub

' Returns the item if it is a Business Contact or Account,
' otherwise creates a new Lead
Function GetOpportunityParent(bcmRootFolder As Outlook.Folder, _
oItem As Object, _
bSave As Boolean) As Outlook.ContactItem
Set GetOpportunityParent = Nothing
If oItem Is Nothing Then
Exit Function
End If
Dim oContactItem As Outlook.ContactItem
Set oContactItem = Nothing
' Only get EntryID if Business Contact or Account
If oItem.MessageClass = "IPM.Contact.BCM.Contact" Or _
oItem.MessageClass = "IPM.Contact.BCM.Account" Then
' The Contact/Account is the Opportunity parent
Set oContactItem = oItem
Else
Set oContactItem = GetLinkedContact(bcmRootFolder, oItem, bSave)
End If
' Return the parent item
Set GetOpportunityParent = oContactItem
End Function

' Retrieves the existing Business Contact or Account,
' otherwise creates a new Lead
Function GetLinkedContact(bcmRootFolder As Outlook.Folder, _
oItem As Object, _
bSave As Boolean) As Outlook.ContactItem
Set GetLinkedContact = Nothing
If oItem Is Nothing Then
Exit Function
End If
Dim oContactItem As Outlook.ContactItem
Set oContactItem = Nothing
Dim oMailItem As Outlook.MailItem
Set oMailItem = Nothing
' If this is an e-mail message, look for the linked contact/account
If oItem.MessageClass = "IPM.Note" Then
' Locate the corresponding Business Contact or Account
Set oMailItem = oItem
Dim strEmailAddress As String
strEmailAddress = oMailItem.SenderEmailAddress
Set oContactItem = GetContactFromEmail(bcmRootFolder, _
"Business Contacts", strEmailAddress)
' If no matching Business Contact was found,
' look for a matching Account
If oContactItem Is Nothing Then
Set oContactItem = GetContactFromEmail _
(bcmRootFolder, "Accounts", strEmailAddress)
End If
End If
' If neither exists, create a new Lead
If oContactItem Is Nothing Then
Set oContactItem = CreateLeadFromEmail _
(bcmRootFolder, oMailItem, bSave)
' Save the new Lead as needed to generate an EntryID
If Not (oContactItem Is Nothing) And bSave Then
oContactItem.Save
End If
End If
' Return the parent item
Set GetLinkedContact = oContactItem
End Function

' Looks up a Business Contact or Account by e-mail address
Function GetContactFromEmail(bcmRootFolder As Outlook.Folder, _
bcmSubFolder As String, _
strEmailAddress As String) _
As Outlook.ContactItem
Set GetContactFromEmail = Nothing
If bcmRootFolder Is Nothing Or bcmSubFolder = "" Or _
strEmailAddress = "" Then
MsgBox "Unable to Get Contact From Email - missing parameter(s)"
Exit Function
End If
' Locate the Business Contacts folder
Dim oContactsFolder As Outlook.Folder
Set oContactsFolder = _
bcmRootFolder.Folders(bcmSubFolder)
If oContactsFolder Is Nothing Or _
oContactsFolder.Items Is Nothing Then
MsgBox "Unable to get the BCM sub-folder"
Exit Function
End If

' Setup the filter restriction string
Dim strRestriction As String
strRestriction = "[Email1Address] = '" & strEmailAddress & "'"
Dim contacts As Outlook.Items
Set contacts = oContactsFolder.Items.Restrict(strRestriction)
If contacts Is Nothing Then
Exit Function
End If

' Add each contact to the list of Account contacts
Dim oContact As Object
Dim i As Integer
For Each oContact In contacts
' Return the first valid contact item
If Not (oContact Is Nothing) Then
Exit For
End If
Next
Set GetContactFromEmail = oContact
Set contacts = Nothing
Set oContactsFolder = Nothing
End Function

' Creates and displays a Lead. If an e-mail message is selected, the Lead
' fields are populated using the sender's name and e-mail address and
' the e-mail contents are used to populate the Lead fields
Sub Lead()
Dim oLead As Outlook.ContactItem
Set oLead = Nothing

' 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

' 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")
Dim BcmContactItem As Outlook.ContactItem

' Get a reference to the currently selected item
Dim oItem As Object
' Make sure at least one item is selected
If Not (Application.ActiveExplorer Is Nothing) Then
If Not (Application.ActiveExplorer.Selection Is Nothing) Then
If Application.ActiveExplorer.Selection.Count > 0 Then
Set oItem = Application.ActiveExplorer.Selection(1)
End If
End If
End If

' Get existing Lead or create a new one
Set oLead = GetLinkedContact(bcmRootFolder, oItem, False)

' If we found or created a Lead, display it
If Not (oLead Is Nothing) Then
oLead.Display (False)
End If
End Sub

' Creates a Lead from an e-mail message
Function CreateLeadFromEmail(bcmRootFolder As Outlook.Folder, _
oMailItem As Outlook.MailItem, _
bSave As Boolean) _
As Outlook.ContactItem
Set CreateLeadFromEmail = Nothing
Dim oLead As Outlook.ContactItem
Set oLead = Nothing
' Locate the Contacts folder
Dim oContactsFolder As Outlook.Folder
Set oContactsFolder = _
bcmRootFolder.Folders("Business Contacts")
If oContactsFolder Is Nothing Then
MsgBox "Unable to get Business Contacts folder"
Exit Function
End If
' Create a new Lead
Const ContactMessageClass = "IPM.Contact.BCM.Contact"
Dim newLead As Outlook.ContactItem
Set newLead = _
oContactsFolder.Items.Add(ContactMessageClass)
If newLead Is Nothing Then
MsgBox "Unable to Create New Lead from Email"
Exit Function
End If
' Set the Lead flag
Dim oLeadProp As Outlook.UserProperty
Set oLeadProp = _
newLead.UserProperties("Lead")
If (oLeadProp Is Nothing) Then
Set oLeadProp = _
newLead.UserProperties.Add("Lead", _
Outlook.olYesNo, False, False)
End If
oLeadProp.Value = True

' See if we have an e-mail message
If oMailItem Is Nothing Then
If bSave Then
oLead.Save
End If
Else
newLead.FullName = oMailItem.SenderName
newLead.Email1Address = oMailItem.SenderEmailAddress
' Parse other lead information from the web form mail
Call ParseWebForm(oMailItem, bSave, newLead, Nothing)
End If
Set CreateLeadFromEmail = newLead
End Function

' Create an Opportunity and link it to the parent item
Function CreateOpportunity(oParentItem As Outlook.ContactItem, _
oMailItem As Outlook.MailItem, _
bcmRootFolder As Outlook.Folder, _
bSave As Boolean) _
As Outlook.TaskItem
' Initialize result to Nothing
Set CreateOpportunity = Nothing

' Locate the Opportunities folder
Dim opportunitiesFolder As Outlook.Folder
Set opportunitiesFolder = _
bcmRootFolder.Folders("Opportunities")

If opportunitiesFolder Is Nothing Then
MsgBox "Unable to get Opportunities folder"
Exit Function
End If

' Create a new Opportunity
Const OpportunityMessageClass = "IPM.Task.BCM.Opportunity"
Dim oNewOpportunity As Outlook.TaskItem
Set oNewOpportunity = _
opportunitiesFolder.Items.Add(OpportunityMessageClass)

If oNewOpportunity Is Nothing Then
MsgBox "Unable to create opportunity"
Exit Function
End If

' Set the opportunity title
If Not (oMailItem Is Nothing) Then
oNewOpportunity.Subject = Trim(oMailItem.Subject)
End If

' Store the parent EntryID and Display Name
If Not (oParentItem Is Nothing) Then
Dim strParentEntryID As String
Dim strParentDisplayName As String
strParentEntryID = oParentItem.EntryID
strParentDisplayName = oParentItem.FullName
End If

' Verify that we have these parameters
If strParentEntryID <> "" And _
strParentDisplayName <> "" Then

' Link the new Opportunity to the selected BCM item
Dim parentEntityEntryID As Outlook.UserProperty
Set parentEntityEntryID = _
oNewOpportunity.UserProperties("Parent Entity EntryID")
If (parentEntityEntryID Is Nothing) Then
Set parentEntityEntryID = _
oNewOpportunity.UserProperties.Add( _
"Parent Entity EntryID", _
olText, False, False)
End If
parentEntityEntryID.Value = strParentEntryID

' Parent Entry ID
Dim parentEntryID As Outlook.UserProperty
Set parentEntryID = _
oNewOpportunity.UserProperties("Parent Entry ID")
If (parentEntryID Is Nothing) Then
Set parentEntryID = _
oNewOpportunity.UserProperties.Add("Parent Entry ID", _
olKeywords, False, False)
End If
parentEntryID.Value = strParentEntryID

' Parent Display Name
Dim parentDisplayName As Outlook.UserProperty
Set parentDisplayName = _
oNewOpportunity.UserProperties("ParentDisplayName")
If (parentDisplayName Is Nothing) Then
Set parentDisplayName = _
oNewOpportunity.UserProperties.Add("ParentDisplayName", _
olText, False, False)
End If
parentDisplayName.Value = strParentDisplayName
End If

' Parse Opportunity information from the web form mail
Call ParseWebForm(oMailItem, bSave, Nothing, oNewOpportunity)

' Save the new Opportunity as needed
If bSave Then
oNewOpportunity.Save
End If

' Return the new Opportunity
Set CreateOpportunity = oNewOpportunity
End Function

Sub ParseWebForm(oMailItem As Outlook.MailItem, _
bSave As Boolean, _
Optional oParentItem As Outlook.ContactItem, _
Optional oOpportunity As Outlook.TaskItem)
' Get the mail body
Dim strMailBody As String
strMailBody = oMailItem.Body

' Create a Regular Expression Object
Dim RegX As Object
Set RegX = CreateObject("vbscript.regexp")
If RegX Is Nothing Then
MsgBox "Unable to create Regular Expression object"
Exit Sub
End If
' Remove any prefix
If conPrefix <> "" Then
RegX.Pattern = "(?:[`~!@#$%^&*()-_+=\[\]{}<>,.\/?\w\s])*?" & _
conPrefix
RegX.IgnoreCase = True
RegX.Global = False
strMailBody = RegX.Replace(strMailBody, "")
End If
' Remove any postfix
If conPostfix <> "" Then
RegX.Pattern = _
conPostfix & "(?:[`~!@#$%^&*()-_+=\[\]{}<>,.\/?\w\s])+"
RegX.IgnoreCase = True
RegX.Global = False
strMailBody = RegX.Replace(strMailBody, "")
End If

' Validate the delimeter character for use in our regular expression
Dim strDelimeter As String
strDelimeter = Right(conDelimeter, 1)
RegX.Pattern = "[\?\*\+\.\|\{\}\\\[\]\(\)]"
RegX.IgnoreCase = True
RegX.Global = False
Dim colValues As Variant
Set colValues = RegX.Execute(strDelimeter)
If colValues.Count > 0 Then
strDelimeter = "\" & strDelimeter
End If

' Find name-value pairs
RegX.Pattern = "(.*)" & strDelimeter & "[ \t]*(.*)"
RegX.IgnoreCase = True
RegX.Global = True
Set colValues = RegX.Execute(strMailBody)
If colValues Is Nothing Then
Exit Sub
End If

Dim arrProperties() As Variant
arrProperties = MapProperties()

' Make sure we have at least 5 attributes per property
If UBound(arrProperties, 2) < 4 Then
MsgBox ("Missing some property attributes")
Exit Sub
End If

Dim i As Integer
Dim strFormPropName As String
Dim strOLPropName As String
Dim strValue As String
Dim itemProp As Outlook.ItemProperty
Dim userProp As Outlook.UserProperty

' Get and save properties
For Each Value In colValues
' Retrieve property name
RegX.Pattern = strDelimeter & "[ \t]*(.*)"
strFormPropName = RegX.Replace(CStr(Value), "")

' Retrieve property value
RegX.Pattern = "(.*)" & strDelimeter & "[ \t]*"
strValue = RegX.Replace(CStr(Value), "")
' Remove any trailing carriage returns
strValue = Replace(strValue, Chr(13), "")
' Remove any trailing form feeds
strValue = Replace(strValue, Chr(10), "")
' Get the property attributes
i = GetPropertyIndex(arrProperties, strFormPropName)
' Save this property value if it has a value and attributes
If strValue <> "" And _
i >= 0 Then
' Get the Outlook propertyName
strOLPropName = arrProperties(i, 1)
' Lead Property and we have a parent
If arrProperties(i, 2) And Not (oParentItem Is Nothing) Then
' ItemProperty
If arrProperties(i, 4) Then
Set itemProp = _
oParentItem.ItemProperties(strOLPropName)
If (itemProp Is Nothing) Then
Set itemProp = _
oParentItem.ItemProperties.Add(strOLPropName, _
arrProperties(i, 3), _
False, False)
End If
SetProperty itemProp, CInt(arrProperties(i, 3)), _
strValue
' UserProperty
Else
Set userProp = _
oParentItem.UserProperties(strOLPropName)
If (userProp Is Nothing) Then
Set userProp = _
oParentItem.UserProperties.Add(strOLPropName, _
arrProperties(i, 3), _
False, False)
End If
SetProperty userProp, CInt(arrProperties(i, 3)), _
strValue
End If
' Opportunity Property and we have an opportunity
ElseIf Not arrProperties(i, 2) And _
Not (oOpportunity Is Nothing) Then
' ItemProperty
If arrProperties(i, 4) Then
Set itemProp = _
oOpportunity.ItemProperties(strOLPropName)
If (itemProp Is Nothing) Then
Set itemProp = _
oParentItem.ItemProperties.Add(strOLPropName, _
arrProperties(i, 3), _
False, False)
End If
SetProperty itemProp, CInt(arrProperties(i, 3)), _
strValue
' UserProperty
Else
Set userProp = _
oOpportunity.UserProperties(strOLPropName)
If (userProp Is Nothing) Then
Set userProp = _
oOpportunity.UserProperties.Add(strOLPropName, _
arrProperties(i, 3), _
False, False)
End If
' Save the property
SetProperty userProp, CInt(arrProperties(i, 3)), _
strValue
End If
End If
End If
Next
If Not (oParentItem Is Nothing) And bSave Then
' Save any updates to the parent item
oParentItem.Save
End If
End Sub

' Returns the property attributes for a given property name
Function GetPropertyIndex(arrProperties() As Variant, strPropertyName) _
As Integer
Dim i As Integer
For i = LBound(arrProperties, 1) To UBound(arrProperties, 1)
If strPropertyName = arrProperties(i, 0) Then
GetPropertyIndex = i
Exit Function
End If
Next
GetPropertyIndex = -1
End Function

' Set the Outlook property value
Sub SetProperty(prop As Object, iType As Integer, strValue As String)
On Error Resume Next
If olYesNo = iType Then
If InStr(1, strValue, "Yes", vbTextCompare) Or _
InStr(1, strValue, "True", vbTextCompare) Then
prop.Value = True
Else
prop.Value = False
End If
ElseIf olNumber = iType Or _
olInteger = iType Then
prop.Value = CInt(strValue)
Else
prop.Value = strValue
End If
If Err.Number <> 0 Then
Dim strPropName As String
strPropName = prop.Name
MsgBox "Unable to set property '" & strPropName & _
"' to value '" & strValue & "'. Please check the property " & _
"type, value, and if it is a UserProperty or ItemProperty."
End If
On Error GoTo 0
End Sub
'////////////////////////////////////////////////////////////////////////

 

[Lon Orenstein]

Clinton:

Some feedback, questions, and direction for others...

1. I first copied your posts and code into OneNote which must have added
some characters. When I pasted it into the VB editor, I got compile errors.
So, I would recommend others paste the code into Notepad first and then
paste into the VB editor or just paste directly into the editor. Also, copy
all the code starting and ending with '/////

2. What's the chance you could update this code with duplicate checking on
Email Address? When testing this against one of our forms, it created
duplicate contacts because people downloaded our software more than once. A
follow on -- what if you're adding an Opportunity; can it create an
additional Opportunity for the same contact?

3. What's the best way to handle multiple forms? Some of our forms collect
just name and email, and others collect address and custom field info.
Should I just add those fields to the existing code or create a new
Module/script and use a rule to automate each form based on the Subject of
the email?

4. You mentioned in your notes that Comments are limited to a single line.
What's the limit on characters for that?

5. Does the Web Form property name, arrProperties(ax,0), have to match
exactly or does it function as "contains" would?

Thanks again, Clinton. This really gives users a great way to automate
getting data from their website into BCM...

Lon

___________________________________________________________
Lon Orenstein
pinpointtools, llc
(e-mail address removed)
Author of Outlook 2007 Business Contact Manager For Dummies
Author of the eBook: Moving from ACT! to Business Contact Manager
800.238.0560 x6104 Toll Free (U.S. only) +1 214.905.0401 x6104
www.pinpointtools.com

 

[mrtimpeterson via OfficeKB.com]

I hate to be the cranky old spoiler who rains on everyone's party with a
reality check but my finger got fatigued just scrolling all the way down
through all of that scary looking macro-code stuff or whatever. I am happy
for all the geeks out there who rejoice but is there an easier way to add
this to BCM? (BCM 3.1 version update download with wizard?) This would be
more realistic for all of the lazier dummies out there like myself who have a
business to run and don't have a lot of time to learn how to be programmers?

-THP

Clinton:

Some feedback, questions, and direction for others...

1. I first copied your posts and code into OneNote which must have added
some characters. When I pasted it into the VB editor, I got compile errors.
So, I would recommend others paste the code into Notepad first and then
paste into the VB editor or just paste directly into the editor. Also, copy
all the code starting and ending with '/////

2. What's the chance you could update this code with duplicate checking on
Email Address? When testing this against one of our forms, it created
duplicate contacts because people downloaded our software more than once. A
follow on -- what if you're adding an Opportunity; can it create an
additional Opportunity for the same contact?

3. What's the best way to handle multiple forms? Some of our forms collect
just name and email, and others collect address and custom field info.
Should I just add those fields to the existing code or create a new
Module/script and use a rule to automate each form based on the Subject of
the email?

4. You mentioned in your notes that Comments are limited to a single line.
What's the limit on characters for that?

5. Does the Web Form property name, arrProperties(ax,0), have to match
exactly or does it function as "contains" would?

Thanks again, Clinton. This really gives users a great way to automate
getting data from their website into BCM...

Lon

___________________________________________________________
Lon Orenstein
pinpointtools, llc
(e-mail address removed)
Author of Outlook 2007 Business Contact Manager For Dummies
Author of the eBook: Moving from ACT! to Business Contact Manager
800.238.0560 x6104 Toll Free (U.S. only) +1 214.905.0401 x6104
www.pinpointtools.com

Prospective customers often visit a company's web site before doing
business.

[quoted text clipped - 87 lines]

(I'll post the VBA Macro in a reply to this post due to the macro length)

 

[Lon Orenstein]

Is anyone using this code from Clinton?

Does anyone have an interest in getting contacts from your website entered
into BCM automatically? We're working on this now and are curious what
others are doing or need to do?

Thanks,
Lon

___________________________________________________________
Lon Orenstein
pinpointtools, llc
(e-mail address removed)
Author of Outlook 2007 Business Contact Manager For Dummies
Author of the eBook: Moving from ACT! to Business Contact Manager
www.pinpointtools.com

Clinton:

Some feedback, questions, and direction for others...

1. I first copied your posts and code into OneNote which must have added
some characters. When I pasted it into the VB editor, I got compile
errors. So, I would recommend others paste the code into Notepad first and
then paste into the VB editor or just paste directly into the editor.
Also, copy all the code starting and ending with '/////

2. What's the chance you could update this code with duplicate checking
on Email Address? When testing this against one of our forms, it created
duplicate contacts because people downloaded our software more than once.
A follow on -- what if you're adding an Opportunity; can it create an
additional Opportunity for the same contact?

3. What's the best way to handle multiple forms? Some of our forms
collect just name and email, and others collect address and custom field
info. Should I just add those fields to the existing code or create a new
Module/script and use a rule to automate each form based on the Subject of
the email?

4. You mentioned in your notes that Comments are limited to a single
line. What's the limit on characters for that?

5. Does the Web Form property name, arrProperties(ax,0), have to match
exactly or does it function as "contains" would?

Thanks again, Clinton. This really gives users a great way to automate
getting data from their website into BCM...

Lon

___________________________________________________________
Lon Orenstein
pinpointtools, llc
(e-mail address removed)
Author of Outlook 2007 Business Contact Manager For Dummies
Author of the eBook: Moving from ACT! to Business Contact Manager
800.238.0560 x6104 Toll Free (U.S. only) +1 214.905.0401 x6104
www.pinpointtools.com

 

[mrtimpeterson via OfficeKB.com]

I would love to be able to have an automated Website lead generator like this.
I just haven't had the time to figure all of the above code out at all. If
there were an easier designed way to install this, I would use it.

-THP

Is anyone using this code from Clinton?

Does anyone have an interest in getting contacts from your website entered
into BCM automatically? We're working on this now and are curious what
others are doing or need to do?

Thanks,
Lon

___________________________________________________________
Lon Orenstein
pinpointtools, llc
(e-mail address removed)
Author of Outlook 2007 Business Contact Manager For Dummies
Author of the eBook: Moving from ACT! to Business Contact Manager
www.pinpointtools.com

Clinton:

[quoted text clipped - 135 lines]