B
Bob
I'm trying to set up a rule in Outlook 2003 to parse text from a sales
lead using a variation of Sue Mosher's code located at
http://www.outlookcode.com/threads.aspx?forumid=2&messageid=696.
The code as adapted for my application is shown below. I have a
message box to return string values. Currently the message box returns
empty strings (TransID = ). Once I get that to work I
want to pass the string values to an Access database.
Code
---------------------------------------------------------------------------------------------------------
Function ParseTextLinePair(strSource As String, strLabel As String)
Dim intLocLabel As Integer
Dim intLocCRLF As Integer
Dim intLenLabel As Integer
Dim strText As String
' locate the label in the source text
intLocLabel = InStr(strSource, strLabel)
intLenLabel = Len(strLabel)
If intLocLabel > 0 Then
intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
If intLocCRLF > 0 Then
intLocLabel = intLocLabel + intLenLabel
strText = Mid(strSource, _
intLocLabel, _
intLocCRLF - intLocLabel)
Else
intLocLabel = Mid(strSource, intLocLabel + intLenLabel)
End If
End If
ParseTextLinePair = Trim(strText)
End Function
---------------------------------------------------------------------------------------------------------------------------
Sub CustomMailMessageRule(Item As Outlook.MailItem)
MsgBox "Mail message arrived: " & Item.Subject
'GetWareInfoFromIncomingMessage()
'modified from
http://www.outlookcode.com/threads.aspx?forumid=2&messageid=696
On Error Resume Next
Dim strTransID As String
Dim strFirstName As String
Dim strLastName As String
Dim strEveningPhone As String
Dim strDayPhone As String
Dim strEmail As String
Dim strYear As String
Dim strMake As String
Dim strModel As String
Dim strSeries As String
Dim strBodyStyle As String
Dim strEngine As String
Dim strTrans As String
Dim strColor As String
Dim strMileage As String
Dim strExterior As String
Dim strComments As String
Dim strNewYear As String
Dim strNewMake As String
Dim strNewModel As String
Dim strNewStyle As String
Dim strNewColor As String
Dim strSource As String
If objItem.Class = olMail Then
strTransID = ParseTextLinePair(objItem.Body, "Transaction_ID:")
strFirstName = ParseTextLinePair(objItem.Body, "First_Name:")
strLastName = ParseTextLinePair(objItem.Body, "Last_Name:")
strEveningPhone = ParseTextLinePair(objItem.Body, "Evening Phone:")
strDayPhone = ParseTextLinePair(objItem.Body, "Day Phone:")
strEmail = ParseTextLinePair(objItem.Body, "E-Mail:")
strYear = ParseTextLinePair(objItem.Body, "Year:")
strMake = ParseTextLinePair(objItem.Body, "Make:")
strModel = ParseTextLinePair(objItem.Body, "Model:")
strSeries = ParseTextLinePair(objItem.Body, "Series:")
strBodyStyle = ParseTextLinePair(objItem.Body, "BodyStyle:")
strEngine = ParseTextLinePair(objItem.Body, "Engine:")
strTrans = ParseTextLinePair(objItem.Body, "Transmission:")
strColor = ParseTextLinePair(objItem.Body, "Color:")
strMileage = ParseTextLinePair(objItem.Body, "Mileage:")
strExterior = ParseTextLinePair(objItem.Body, "Exterior:")
strComments = ParseTextLinePair(objItem.Body, "Comments:")
strNewYear = ParseTextLinePair(objItem.Body, "New Year:")
strNewMake = ParseTextLinePair(objItem.Body, "New Make:")
strNewModel = ParseTextLinePair(objItem.Body, "New Model:")
strNewStyle = ParseTextLinePair(objItem.Body, "New Style:")
strNewColor = ParseTextLinePair(objItem.Body, "New Color:")
strSource = ParseTextLinePair(objItem.Body, "Source:")
End If
MsgBox "Transaction ID = " & strTransID & vbCrLf & "First Name = " &
strFirstName & vbCrLf & "Last Name = " & strLastName & vbCrLf
End Sub
The body of the email that I'm trying to parse text from looks like
this...
----------------------------------------------------------------------------------------------------
Transaction ID: 209786801
** Customer Information **
First Name: John
Last Name: Doe
Evening Phone:
Day Phone: (555) 736-7063
E-Mail: (e-mail address removed)
Zip Code:30039
** Trade-in Information **
Year: 1997
Make: OLDSMOBILE
Model: REGENCY
Series:
BodyStyle: 4D SEDAN
Engine:
Transmission:
Color: Gray
Mileage: 117000
Equipment: Power Sunroof
Condition Report:
Exterior: Body - Good
Exterior: Glass - Good
Exterior: Hail Damage - None
Exterior: Lights - Good
Exterior: Paint - Still Shines
Exterior: Rust - None
Exterior: Spent on Collision Repair - None
Exterior: Unibody/Frame - Good
Interior: Carpet/Mats - Good
Interior: Door Panels - Good
Interior: Upholstery - Good
Expires: December 07, 2006
Comments: Estimated Value$2,060 - $2,950 *** Go to
http://www.blackbookonline.com/dealer to see tips on the best way to
convert this lead to a sale.
** New Vehicle Information **
New Year: 2007
New Make: TOYOTA
New Model: YARIS SEDAN
New Style: AUTOMATIC
New Color: Sage
Source: SalesSource
lead using a variation of Sue Mosher's code located at
http://www.outlookcode.com/threads.aspx?forumid=2&messageid=696.
The code as adapted for my application is shown below. I have a
message box to return string values. Currently the message box returns
empty strings (TransID = ). Once I get that to work I
want to pass the string values to an Access database.
Code
---------------------------------------------------------------------------------------------------------
Function ParseTextLinePair(strSource As String, strLabel As String)
Dim intLocLabel As Integer
Dim intLocCRLF As Integer
Dim intLenLabel As Integer
Dim strText As String
' locate the label in the source text
intLocLabel = InStr(strSource, strLabel)
intLenLabel = Len(strLabel)
If intLocLabel > 0 Then
intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
If intLocCRLF > 0 Then
intLocLabel = intLocLabel + intLenLabel
strText = Mid(strSource, _
intLocLabel, _
intLocCRLF - intLocLabel)
Else
intLocLabel = Mid(strSource, intLocLabel + intLenLabel)
End If
End If
ParseTextLinePair = Trim(strText)
End Function
---------------------------------------------------------------------------------------------------------------------------
Sub CustomMailMessageRule(Item As Outlook.MailItem)
MsgBox "Mail message arrived: " & Item.Subject
'GetWareInfoFromIncomingMessage()
'modified from
http://www.outlookcode.com/threads.aspx?forumid=2&messageid=696
On Error Resume Next
Dim strTransID As String
Dim strFirstName As String
Dim strLastName As String
Dim strEveningPhone As String
Dim strDayPhone As String
Dim strEmail As String
Dim strYear As String
Dim strMake As String
Dim strModel As String
Dim strSeries As String
Dim strBodyStyle As String
Dim strEngine As String
Dim strTrans As String
Dim strColor As String
Dim strMileage As String
Dim strExterior As String
Dim strComments As String
Dim strNewYear As String
Dim strNewMake As String
Dim strNewModel As String
Dim strNewStyle As String
Dim strNewColor As String
Dim strSource As String
If objItem.Class = olMail Then
strTransID = ParseTextLinePair(objItem.Body, "Transaction_ID:")
strFirstName = ParseTextLinePair(objItem.Body, "First_Name:")
strLastName = ParseTextLinePair(objItem.Body, "Last_Name:")
strEveningPhone = ParseTextLinePair(objItem.Body, "Evening Phone:")
strDayPhone = ParseTextLinePair(objItem.Body, "Day Phone:")
strEmail = ParseTextLinePair(objItem.Body, "E-Mail:")
strYear = ParseTextLinePair(objItem.Body, "Year:")
strMake = ParseTextLinePair(objItem.Body, "Make:")
strModel = ParseTextLinePair(objItem.Body, "Model:")
strSeries = ParseTextLinePair(objItem.Body, "Series:")
strBodyStyle = ParseTextLinePair(objItem.Body, "BodyStyle:")
strEngine = ParseTextLinePair(objItem.Body, "Engine:")
strTrans = ParseTextLinePair(objItem.Body, "Transmission:")
strColor = ParseTextLinePair(objItem.Body, "Color:")
strMileage = ParseTextLinePair(objItem.Body, "Mileage:")
strExterior = ParseTextLinePair(objItem.Body, "Exterior:")
strComments = ParseTextLinePair(objItem.Body, "Comments:")
strNewYear = ParseTextLinePair(objItem.Body, "New Year:")
strNewMake = ParseTextLinePair(objItem.Body, "New Make:")
strNewModel = ParseTextLinePair(objItem.Body, "New Model:")
strNewStyle = ParseTextLinePair(objItem.Body, "New Style:")
strNewColor = ParseTextLinePair(objItem.Body, "New Color:")
strSource = ParseTextLinePair(objItem.Body, "Source:")
End If
MsgBox "Transaction ID = " & strTransID & vbCrLf & "First Name = " &
strFirstName & vbCrLf & "Last Name = " & strLastName & vbCrLf
End Sub
The body of the email that I'm trying to parse text from looks like
this...
----------------------------------------------------------------------------------------------------
Transaction ID: 209786801
** Customer Information **
First Name: John
Last Name: Doe
Evening Phone:
Day Phone: (555) 736-7063
E-Mail: (e-mail address removed)
Zip Code:30039
** Trade-in Information **
Year: 1997
Make: OLDSMOBILE
Model: REGENCY
Series:
BodyStyle: 4D SEDAN
Engine:
Transmission:
Color: Gray
Mileage: 117000
Equipment: Power Sunroof
Condition Report:
Exterior: Body - Good
Exterior: Glass - Good
Exterior: Hail Damage - None
Exterior: Lights - Good
Exterior: Paint - Still Shines
Exterior: Rust - None
Exterior: Spent on Collision Repair - None
Exterior: Unibody/Frame - Good
Interior: Carpet/Mats - Good
Interior: Door Panels - Good
Interior: Upholstery - Good
Expires: December 07, 2006
Comments: Estimated Value$2,060 - $2,950 *** Go to
http://www.blackbookonline.com/dealer to see tips on the best way to
convert this lead to a sale.
** New Vehicle Information **
New Year: 2007
New Make: TOYOTA
New Model: YARIS SEDAN
New Style: AUTOMATIC
New Color: Sage
Source: SalesSource