This is the problem:

Set objItem = GetCurrentItem()

The item returned by GetCurrentItem is totally unrelated to the new item received by Outlook that you're running this procedure to process, via a "run a script" rule action. In such a procedure, the item to be processed is passed as the parameter:


Sub RunAScriptRuleRoutine(MyMail As MailItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim msg As Outlook.MailItem
Dim rply as Outlook.MailItem

strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set msg = olNS.GetItemFromID(strID)
' do stuff with msg, e.g.
CustName = ParseTextLinePair(msg.Body, "Owner = ")

Set msg = Nothing
Set rply = Nothing
Set olNS = Nothing
End Sub

--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54


"Steve" wrote in message ...
I modified this code that I got from OutlookCode

But it doesn't appear to be parsing because I don't get the Message
box


Sub ParseValidationEmail(MyMail As MailItem)
Dim objItem As Object
Dim intLocAddress As Integer
Dim intLocCRLF As Integer
Dim Custemail As String
Dim CustName As String
Dim Product As String
Dim CustOrderDate As String
Dim CustValidationCode As String


Set objItem = GetCurrentItem()
If objItem.Class = olMail Then
' find the Order Info
Custemail = olMail.To
CustName = ParseTextLinePair(objItem.Body, "Owner = ")
Product = ParseTextLinePair(objItem.Body, "Program = ")
CustOrderDate = ParseTextLinePair(objItem.Body, "Validation Date =
")
CustValidationCode = ParseTextLinePair(objItem.Body, "Validation
Code = ")

MsgBox (Custemail)
MsgBox (CustName)
MsgBox (Product)
MsgBox (CustOrderDate)
MsgBox (CustValidationCode)
'MsgBox (strAddress)

End If

Set objReply = Nothing
Set objItem = Nothing
End Sub

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

Function GetCurrentItem() As Object
Dim objApp As Outlook.Application

Set objApp = CreateObject("Outlook.Application")
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem =
objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
Case Else
' anything else will result in an error, which is
' why we have the error handler above
End Select

Set objApp = Nothing
End Function