I'm trying to find an easy way of parsing emails I'm cc'ed on for my
customer's orders.

I want to load parsed fields into an Online database (Access or
MySQL).
1. Search for new emails where subject = "Guru2008 Validation Code"
2. Parse email
3. Load data into database.


I bought a parsing program but since AT&T uses yahoo as the pop3
server
I can't get on - I think its due to the server using 995


Please help if you can
Thanks
Steve


Fields I want to capture are.

To email address (This is the customers email address)
Owner
Program
Validation Code
Validation Date
Serial



Email Subject "Guru2008 Validation Code"

***Email Body Start***

Please copy the Validation Code below

Owner = User
Program = Guru2008
Validation Date = Tuesday, November 13, 2007
Validation Code = Z570-U981-H344-O240
Serial = 1278E28

Thank You!
The Guru

***Email Body End***

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

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

This code should get you started. It uses Excel to manipulate the
Outlook object model. It is untested so test it first! Paste the code
into a standard module in Excel and step through the code first to
make sure it does what you want. Of course it puts the email info into
a spreadsheet and saves it in your default folder (usually My
Documents). It checks unread items only in your Inbox and marks them
as read so it won't add duplicate info to the spreadsheet. If you plan
on doing this regularly, you would need to modify the code to open an
existing workbook, update it, save and close, instead of writing a new
file each time.


Sub ParseEmail()
'
' set a reference to Outlook Object Model first
'
' replace "your email here" with your email address (in quotes of
course)
'
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olInbox As Outlook.MAPIFolder
Dim Item As Outlook.MailItem
Dim NewWB As Excel.Workbook
Dim CurrRow As Long
Dim sDate As String

Dim sOwner As String
Dim iOwnerStart As Long
Dim iOwnerEnd As Long

Dim sProgram As String
Dim iProgramStart As Long
Dim iProgramEnd As Long

Dim sVDate As String
Dim iVDateStart As Long
Dim iVDateEnd As Long

Dim sVCode As String
Dim iVCodeStart As Long
Dim iVCodeEnd As Long

Dim sSerial As String
Dim iSerialStart As Long
Dim iSerialEnd As Long

Application.ScreenUpdating = False

' gain access to Inbox
Set olApp = GetObject(, "outlook.application")
Set olNS = olApp.GetNamespace("MAPI")
Set olInbox = olNS.GetDefaultFolder(olFolderInbox)

' set up workbook for data entry
Set NewWB = Workbooks.Add
sDate = Format(Now, "MMDDYYHHMM")

ActiveWorkbook.SaveAs sDate & " Codes", FileFormat:=xlNormal

Cells(1, 1) = "Sender Email Address"
Cells(1, 2) = "Owner"
Cells(1, 3) = "Program"
Cells(1, 4) = "Validation Date"
Cells(1, 5) = "Validation Code"
Cells(1, 6) = "Serial"

With Range(Cells(1, 1), Cells(1, 6))
.Interior.ColorIndex = 14
.AutoFilter visibledropdown:=True
With .Font
.ColorIndex = 2
.Bold = True
End With
End With

' check unread items only
If olInbox.UnReadItemCount 0 Then
For Each Item In olInbox.Items.Restrict("[Unread] = True")
If (Item.Subject = "Guru2008 Validation Code") And (Item.CC =
"your email here") Then
item.UnRead = False
' get email body info
iOwnerStart = InStr(1, Item.Body, "Owner")
iOwnerEnd = InStr(iOwnerStart + 8, Item.Body, " ")
sOwner = Mid$(Item.Body, iOwnerStart, iOwnerEnd -
iOwnerStart)

iProgramStart = InStr(1, Item.Body, "Program")
iProgramEnd = InStr(iProgramStart + 10, Item.Body, " ")
sProgram = Mid$(Item.Body, iProgramStart, iProgramEnd -
iProgramStart)

iVDateStart = InStr(1, Item.Body, "Validation Date")
iVDateEnd = InStr(iVDateStart + 18, Item.Body, " ")
sVDate = Mid$(Item.Body, iVDateStart, iVDateEnd -
iVDateStart)

iVCodeStart = InStr(1, Item.Body, "Validation Code")
iVCodeEnd = InStr(iVCodeStart + 18, Item.Body, " ")
sVCode = Mid$(Item.Body, iVCodeStart, iVCodeEnd -
iVCodeStart)

iSerialStart = InStr(1, Item.Body, "Serial")
iSerialEnd = InStr(iSerialStart + 9, Item.Body, " ")
sSerial = Mid$(Item.Body, iSerialStart, iSerialEnd -
iSerialStart)

' find next available row and paste info
CurrRow = Range("A65536").End(xlUp).Offset(1, 0).Row
Excel.Cells(CurrRow, 1) = Item.SenderEmailAddress
Excel.Cells(CurrRow, 2) = sOwner
Excel.Cells(CurrRow, 3) = sProgram
Excel.Cells(CurrRow, 4) = sVDate
Excel.Cells(CurrRow, 5) = sVCode
Excel.Cells(CurrRow, 6) = sSerial
ActiveWorkbook.Close True
End If
Next Item
End If


Set olInbox = Nothing
Set olNS = Nothing
Set olApp = Nothing
Set NewWB = Nothing
End Sub



HTH,
JP

On Nov 15, 11:37 am, Steve wrote:
I'm trying to find an easy way of parsing emails I'm cc'ed on for my
customer's orders.

I want to load parsed fields into an Online database (Access or
MySQL).
1. Search for new emails where subject = "Guru2008 Validation Code"
2. Parse email
3. Load data into database.

I bought a parsing program but since AT&T uses yahoo as the pop3
server
I can't get on - I think its due to the server using 995

Please help if you can
Thanks
Steve

Fields I want to capture are.

To email address (This is the customers email address)
Owner
Program
Validation Code
Validation Date
Serial

Email Subject "Guru2008 Validation Code"

***Email Body Start***

Please copy the Validation Code below

Owner = User
Program = Guru2008
Validation Date = Tuesday, November 13, 2007
Validation Code = Z570-U981-H344-O240
Serial = 1278E28

Thank You!
The Guru

***Email Body End***