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
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
