extract outlook message body into excel?

[sampson32]

Another Project:

One of our engineers receives a lot of emails requesting our “Product CD”

All of the emails received are in the format below:

*********************************
…………….(Subject Line)………….

FW: ORDER For Product Information CD

…………..(Message Body)…………….

Please provide the following prospective client with the
requested information as soon as possible.

Sent To: engineering@CCengineering.com
Last Name: KINGMAN
First Name: GEORGE
Company: KINGMAN ENGINEERING
E-Mail: GEORGEKINGMAN@EMAIL.COM
Phone: 800-775-4623, Ext.
Fax: 888-775-4635
Street Address: 2004 N.E. 77th STREET
City, State, ZIP: TAMPA, FL 33619

Questions/Comments:
Replace this text with your questions/comments
************************************

Below is a macro I ran across that is supposed to extract specific text lines and put them into excel in the following format:

Last Name (A1) First Name (B1) Company (C1) Street Address (D1) City, State, ZIP (E1)

KINGMAN (A2) GEORGE (B2) KI..ENG…(C2) 2004 N.E. 77...(D2) Tampa, FL, 33612 (E2)

(Some of the above data is truncated in this example to fit in one line)

************************************

This is the code:


Option Explicit
Option Compare Text

Sub ReadInbox()
Dim appOL As Outlook.Application
Dim oSpace As Outlook.NameSpace
Dim oFolder As Outlook.MAPIFolder
Dim oItems As Outlook.Items
Dim oMail As Outlook.MailItem

Set appOL = CreateObject("Outlook.Application")
Set oSpace = appOL.GetNamespace("MAPI")
Set oFolder = oSpace.GetDefaultFolder(olFolderInbox)
Set oItems = oFolder.Items
oItems.Sort "Received", True
For Each oMail In oItems
If oMail.Subject Like "*Product Information CD*" Then
Call bodyStrip(oMail)
End If
Next
End Sub

Sub bodyStrip(msg As Outlook.MailItem)
Dim sBody As String
Dim aFields As Variant
Dim r As Range
Dim n&, iPos1&, ipos2&

aFields = Array("Last Name=", "First Name=", "Company=", "Street Address=", “City, State, ZIP=”)

Set r = [a65536].End(xlUp).Offset(1).Resize(, 4)
sBody = msg.Body

For n = 1 To 4
iPos1 = InStr(ipos2 + 1, sBody, aFields(n - 1))
If iPos1 > 0 Then
iPos1 = iPos1 + Len(aFields(n - 1))
ipos2 = InStr(iPos1 + 1, sBody, vbCrLf)
r = Mid(sBody, iPos1, ipos2 - iPos1)
Else
Exit For
End If
Next
End Sub


The original code had four “afields” – I renamed them to coincide with our email row headings and added a fourth aField. (City, State, ZIP)

This code is totally beyond me ….

Does anyone know how to correct this code to work as I’ve outlined?

Any help appreciated.

Sam

 

[TommyGun]

Well, it wasn't a line-feed character, it was a tab. If you change the SplitString fuction to this, it should "clean" the information for you.


<font face=Courier New><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Function</SPAN> SplitString(value <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, delimeter <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
    SplitString = Application.WorksheetFunction.Clean(Trim(Mid(value, InStr(1, value, delimeter) + 2, _
        Len(value) - InStr(1, value, delimeter))))
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN>
</FONT>

 

[sampson32]

Thank you very much TommyGun!

I would be lost without the help I receive at this forum.

Again, many thanks!

Sam

 

[rian]

Hi

Hi friends,

I am in similar trouble, well I have pasted the code in outlook editor and getting user defined error "ws As Worksheet". I am using Outlook and office 2003.


I just want Email address, subject line from my outlook folder "ADCH"

I hope, if you can help or give me some referrence.

Regards,