Question

Locked

Can anyone help with this VBA code to extract data from an email body?

By Larry Tyner ·
I am new to using VBA.

I am trying to extract data from the body of emails that have the same format. I am using Outlook 2007 and Excel 2007.

This is a sample email body.

Contractor ID Number : 0000001501
First Name : Larry
Last Name : Tyner
undefined : Self
Address Street 1 : 4787 Country Manor Drive Address Street 2 :
City : Sarasota
Zip Code : 34233
State : FL
Email : lttsr1@verizon.net


I have adapted the following code which appears to be reading the data but it is not being placed in a spreadsheet.

Sub Results()

'set up dimensions
Dim Namex As String
Dim i As Long, x As Long, k As Long, b As Long
Dim OLF As Outlook.MAPIFolder, oMAPI As Outlook.NameSpace
Dim Info(10)
Dim CutBack(10)

'set number of characters to be cut off from colon to colon
CutBack(1) = 11
CutBack(2) = 10
CutBack(3) = 10
CutBack(4) = 35
CutBack(5) = 35
CutBack(6) = 25
CutBack(7) = 30
CutBack(8) = 6
CutBack(9) = 3
CutBack(10) = 35

'set up access to mailbox
Set oMAPI = GetObject("", "Outlook.Application").GetNamespace("MAPI")
Set OLF = oMAPI.Folders.Item("Personal Folders").Folders("New Contractor Registrations")

'run through items in folder
For i = 1 To OLF.Items.Count
x = 0
With OLF.Items(i)

'run through body of e-mail
For a = 1 To Len(.Body)

'add one to x every time you find a colon
If Right(Left(.Body, a), 1) = ":" Then
x = x + 1
b = 1
'for each x, get and cut down the string you require
If (0 < x And 11 > x) Then
Info(x) = Empty
Do Until (Right(Left(.Body, a + b), 1) = ":")
Info(x) = Info(x) & Right(Left(.Body, a + b), 1)
b = b + 1
Loop
Info(x) = Left(Info(x), Len(Info(x)) - CutBack(x))

'write out results starting on row 2
Sheets("Results").Cells(i + 1, x) = Info(x)
End If

End If
'move to next character
Next a

End With
Next i

End Sub

Any assistance is appreciated.

This conversation is currently closed to new comments.

23 total posts (Page 1 of 3)   01 | 02 | 03   Next
| Thread display: Collapse - | Expand +

All Answers

Collapse -

Writing to a file is a bit more complicated than that....

by robo_dev In reply to Can anyone help with this ...

To begin with, if 'Results' is a variable, it needs to be declared, no?

http://www.exceluser.com/explore/questions/vba_textcols.htm

You might want to start by writing to a text file, just to get it working, as it's more difficult to write to an excel file

Collapse -

Reponse To Answer

by Larry Tyner In reply to Writing to a file is a bi ...

It appears that the data is being captured, but I obviously am deficient in the file writing.

"Results" is the name of the workbook.

Thanks

Collapse -

To some extent

by NetMan1958 In reply to Can anyone help with this ...

it works for me. I'm using Excel and Outlook 2007. I created a folder in Outlook named "New Contractor Registrations" and placed an email in it that is an exact copy of your example email. It writes " 0000001501" in cell A2, " Larry" in cell B2, " Tyner" in cell C2 (including the leading space in each field) and then I get :
Run-time error '5' :
Invalid procedure call or argument

Collapse -

Reponse To Answer

by Larry Tyner In reply to To some extent

That's what it is supposed to do but loop through multiple emails.

I have have only got the number in cell A2 once. I get Run-time err '5' on this line:
Info(x) = Left(Info(x), Len(Info(x)) - CutBack(x))

Collapse -

Possible Cause

by johnbseaman In reply to Can anyone help with this ...

Ok it could be that 'undefined' is seen as a code response and not a value in excel. You could try changing it another field name i.e. undef or dontknow.

Collapse -

Reponse To Answer

by Larry Tyner In reply to Possible Cause

Edited the email to change field from undefined to Company Name:

Still receive same error message on this line
Info(x) = Left(Info(x), Len(Info(x)) - CutBack(x))

Collapse -

Try Adding

by jboughton29 In reply to Can anyone help with this ...

Try Adding the Option Explicit statement as well.
I still feel that it is unhappy with trying to manipulate an "Empty" string on first go.

Collapse -

Could be a negative length string

by Realvdude In reply to Can anyone help with this ...

If Len(Info(x)) - CutBack(x) goes negative you'll get a error 5.

May I suggest splitting the body into a string array based on vbCrLf (Enter)?

My example just builds the body string, as my Outlook accesses Exchange Server, but you can substitute your body string.

Sub Results()
Dim body As String, sts() As String, iCnt As Integer, colPos As Integer

body = "Contractor ID Number : 0000001501" + vbCrLf + _
"First Name : Larry" + vbCrLf + _
"Last Name : Tyner" + vbCrLf + _
"undefined: Self" + vbCrLf + _
"Address Street 1 : 4787 Country Manor Drive Address Street 2 :" + vbCrLf + _
"City: Sarasota" + vbCrLf + _
"Zip Code : 34233" + vbCrLf + _
"State: FL" + vbCrLf + _
"Email: lttsr1@ verizon.net"

sts() = Split(body, vbCrLf)
For iCnt = 0 To UBound(sts)
colPos = InStr(sts(iCnt), ":")
If colPos > 0 Then 'we have a piece of information
If Len(sts(iCnt)) > colPos + 1 Then 'we have a value for it
'Insert into worksheet
Debug.Print Mid(sts(iCnt), colPos + 1) 'The value
End If
End If
Next
End Sub

You'll note that Address 2: is not handled. You can place it on its own line in the email or add a second InStr starting at colPos + 1 to capture its position.
At the insert into worksheet, you could add a Select statement and check Left(sts(iCnt),colPos -1) for the information name and determine column to place the value.

Collapse -

Saving as a text file

by Spitfire_Sysop In reply to Can anyone help with this ...

I agree that saving the data as a text file first will save you a lot of data processing time. There are functions built in to excel for handling text file input. You are attempting to re-code these functions. You can save each message in to a text file of the same name in a loop using excel to place the data you want in to the proper cells of a workbook. This can all be done from a VBScript within excel.

When you open a text file in excel you can make map the data to cells based on a character like spaces, commas or the colon.

Here is the text open command:
<code>
Workbooks.OpenText Filename:= "emailfile.txt", Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:=":", TrailingMinusNumbers:=True
</code>

The important part is <code>Other:=True, OtherChar:=":"</code>
This will put everything on the right of the colon in column B and then you can do whatever processing you want to it.

Collapse -

This works

by NetMan1958 In reply to Can anyone help with this ...

This code expounds on what "techr" posted above. I tested it and it works for me.

Sub Results()
Dim OLF As Outlook.MAPIFolder, oMAPI As Outlook.Namespace
Dim sts() As String, iCnt As Integer, colPos As Integer, i As Integer, Row As Integer, Col As Integer
Set oMAPI = GetObject("", "Outlook.Application").GetNamespace("MAPI")
Set OLF = oMAPI.Folders.Item("Personal Folders").Folders("New Contractor Registrations")

For i = 1 To OLF.items.Count
Row = i + 1 'current Excel row
sts() = Split(OLF.items(i).body, vbCrLf)
For iCnt = 0 To UBound(sts)
Col = iCnt + 1 'current Excel column
colPos = InStr(sts(iCnt), ":")
If colPos > 0 Then 'we have a piece of information
If Len(sts(iCnt)) > colPos + 1 Then 'we have a value for it
'Insert into worksheet
Sheets("Results").Cells(Row, Col) = Mid(sts(iCnt), colPos + 1)
End If
End If
Next
Next i
End Sub

Back to Hardware Forum
23 total posts (Page 1 of 3)   01 | 02 | 03   Next

Hardware Forums