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.