ParseTextLinePair returns empty string

[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

 

[Sue Mosher [MVP-Outlook]]

There is no code statement to instantiate objItem. A "run a script" rule action procedure should use this approach:

Sub RunAScriptRuleRoutine(Item As MailItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim objItem As Outlook.MailItem

strID = Item.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set objItem = olNS.GetItemFromID(strID)
' do stuff with objItem, e.g.
MsgBox objItem.Body

Set objItem = Nothing
Set olNS = Nothing
End Sub

See http://www.outlookcode.com/d/code/zaphtml.htm#ol2002 for another example.


--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers

 

[Bob]

Thank you so much!

The code and text parse work great now.