Parse Multiple Messages

H

hstockbridge5

Hi,

I can successfully parse elements from one email message using Sue
Mosher's code (GetCurrentItem) and (ParseTextLinePair.) However, I
want to process multiple messages. How would I do that? Would I alter
the GetCurrentItem procedure, the procedure below, or both?

Sub MessageParse()

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Dim fso, f, ts
Dim objItem As Object
Dim intLocAddress As Integer
Dim intLocCRLF As Integer
Dim strTitle As String
Dim strFirstName As String
Dim strLastName As String
Dim strEmail As String
Dim strProf As String
Dim strMedSpec As String
Dim strHosp As String
Dim strCity As String
Dim strState As String
Dim strZip As String
Dim strCountry As String
Dim strRegVia As String
Dim strPromo As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile("c:\Messages.txt")
Set ts = f.OpenAsTextStream(ForAppending, TristateUseDefault)

Set objItem = GetCurrentItem()

If objItem.Class = olMail Then
' Parse items in email body
strTitle = ParseTextLinePair(objItem.Body, "Title:")
strFirstName = ParseTextLinePair(objItem.Body, "First Name:")
strLastName = ParseTextLinePair(objItem.Body, "Last Name:")
strEmail = ParseTextLinePair(objItem.Body, "Email Address:")
strProf = ParseTextLinePair(objItem.Body, "Profession:")
strMedSpec = ParseTextLinePair(objItem.Body, "Medical
Specialty:")
strHosp = ParseTextLinePair(objItem.Body, "Hospital:")
strCity = ParseTextLinePair(objItem.Body, "City:")
strState = ParseTextLinePair(objItem.Body, "State/Province:")
strZip = ParseTextLinePair(objItem.Body, "Postal Code:")
strCountry = ParseTextLinePair(objItem.Body, "Country:")
strRegVia = ParseTextLinePair(objItem.Body, "Registered via:")
strPromo = ParseTextLinePair(objItem.Body, "Promotion Code:")
End If

ts.Write strLastName
ts.WriteLine
ts.Close

Set objItem = Nothing

End Sub
 
M

Michael Bauer

Hi,

instead of Get*CurrentItem* you´d need to loop through your multiple
messages (a selection or items collection).
 
H

hstockbridge5

Michael,

Thanks for the tip. I'm close.... I run the revised code (below) and
receive an object required error. I have obviously missed something.

Here is the revised code:

=============================================

Sub MessageParse()

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Dim fso, f, ts

Dim objOL As Outlook.Application
Dim objCurrent As Outlook.Explorer
Dim objSelection As Outlook.Selection
Dim objMail As Outlook.MailItem
Dim objMsg As Object

Dim intLocAddress As Integer
Dim intLocCRLF As Integer
Dim strTitle As String
Dim strFirstName As String
Dim strLastName As String
Dim strEmail As String
Dim strPass As String
Dim strProf As String
Dim strMedSpec As String
Dim strHosp As String
Dim strCity As String
Dim strState As String
Dim strZip As String
Dim strCountry As String
Dim strRegVia As String
Dim strPromo As String

Set objOL = CreateObject("Outlook.Application")
Set objCurrent = objOL.ActiveExplorer
Set objSelection = objCurrent.Selection

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile("c:\Messages.txt")
Set ts = f.OpenAsTextStream(ForAppending, TristateUseDefault)

For Each objMsg In objSelected
If objMsg.Class = olMail Then
Set objMail = objMsg
strTitle = ParseTextLinePair(objMsg.Body, "Title:")
strFirstName = ParseTextLinePair(objMsg.Body, "First Name:")
strLastName = ParseTextLinePair(objMsg.Body, "Last Name:")
strEmail = ParseTextLinePair(objMsg.Body, "Email Address:")
strPass = ParseTextLinePair(objMsg.Body, "Password:")
strProf = ParseTextLinePair(objMsg.Body, "Profession:")
strMedSpec = ParseTextLinePair(objMsg.Body, "Medical
Specialty:")
strHosp = ParseTextLinePair(objMsg.Body, "Hospital:")
strCity = ParseTextLinePair(objMsg.Body, "City:")
strState = ParseTextLinePair(objMsg.Body, "State/Province:")
strZip = ParseTextLinePair(objMsg.Body, "Postal Code:")
strCountry = ParseTextLinePair(objMsg.Body, "Country:")
strRegVia = ParseTextLinePair(objMsg.Body, "Registered via:")
strPromo = ParseTextLinePair(objMsg.Body, "Promotion Code:")
End If

ts.Write strTitle & ">" & ">" & strFirstName & ">" & strLastName & ">"
& strEmail & ">" & _
strPass & ">" & strProf & ">" & strMedSpec & ">" & strHosp & ">" &
strCity & ">" & strState & ">" & strZip & ">" & strCountry & ">" &
strRegVia & ">" & strPromo
ts.WriteLine
ts.Close

Next objMsg

Set fso = Nothing
Set f = Nothing
Set ts = Nothing
Set objOL = Nothing
Set objCurrent = Nothing
Set objSelection = Nothing
Set objMsg = Nothing

End Sub

==============================================
 
M

Michael Bauer

Hi,

objSelection is declared and set, objSelected is used in the loop. Is
that the error? If not, please help us saving time and show the error
causing line.

--
Viele Grüße
Michael Bauer


Michael,

Thanks for the tip. I'm close.... I run the revised code (below) and
receive an object required error. I have obviously missed something.

Here is the revised code:

=============================================

Sub MessageParse()

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Dim fso, f, ts

Dim objOL As Outlook.Application
Dim objCurrent As Outlook.Explorer
Dim objSelection As Outlook.Selection
Dim objMail As Outlook.MailItem
Dim objMsg As Object

Dim intLocAddress As Integer
Dim intLocCRLF As Integer
Dim strTitle As String
Dim strFirstName As String
Dim strLastName As String
Dim strEmail As String
Dim strPass As String
Dim strProf As String
Dim strMedSpec As String
Dim strHosp As String
Dim strCity As String
Dim strState As String
Dim strZip As String
Dim strCountry As String
Dim strRegVia As String
Dim strPromo As String

Set objOL = CreateObject("Outlook.Application")
Set objCurrent = objOL.ActiveExplorer
Set objSelection = objCurrent.Selection

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile("c:\Messages.txt")
Set ts = f.OpenAsTextStream(ForAppending, TristateUseDefault)

For Each objMsg In objSelected
If objMsg.Class = olMail Then
Set objMail = objMsg
strTitle = ParseTextLinePair(objMsg.Body, "Title:")
strFirstName = ParseTextLinePair(objMsg.Body, "First Name:")
strLastName = ParseTextLinePair(objMsg.Body, "Last Name:")
strEmail = ParseTextLinePair(objMsg.Body, "Email Address:")
strPass = ParseTextLinePair(objMsg.Body, "Password:")
strProf = ParseTextLinePair(objMsg.Body, "Profession:")
strMedSpec = ParseTextLinePair(objMsg.Body, "Medical
Specialty:")
strHosp = ParseTextLinePair(objMsg.Body, "Hospital:")
strCity = ParseTextLinePair(objMsg.Body, "City:")
strState = ParseTextLinePair(objMsg.Body, "State/Province:")
strZip = ParseTextLinePair(objMsg.Body, "Postal Code:")
strCountry = ParseTextLinePair(objMsg.Body, "Country:")
strRegVia = ParseTextLinePair(objMsg.Body, "Registered via:")
strPromo = ParseTextLinePair(objMsg.Body, "Promotion Code:")
End If

ts.Write strTitle & ">" & ">" & strFirstName & ">" & strLastName & ">"
& strEmail & ">" & _
strPass & ">" & strProf & ">" & strMedSpec & ">" & strHosp & ">" &
strCity & ">" & strState & ">" & strZip & ">" & strCountry & ">" &
strRegVia & ">" & strPromo
ts.WriteLine
ts.Close

Next objMsg

Set fso = Nothing
Set f = Nothing
Set ts = Nothing
Set objOL = Nothing
Set objCurrent = Nothing
Set objSelection = Nothing
Set objMsg = Nothing

End Sub

==============================================
 
H

hstockbridge5

Michael,

Thanks for catching my typo. I changed objSelected to objSelection and
now the error appears at:
-----------
ts.Write strTitle & ">" & ">" & strFirstName & ">" & strLastName & ">"
& strEmail & ">" & _
strPass & ">" & strProf & ">" & strMedSpec & ">" & strHosp & ">" &
strCity & ">" & strState & ">" & strZip & ">" & strCountry & ">" &
strRegVia & ">" & strPromo
ts.WriteLine
ts.Close
-----------

Thanks for your patience.

Henry

}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}
 
M

Michael Bauer

Hi Henry,
Dim fso, f, ts
Click to expand...

why do you declare this variables as Variant?

Anyway I can´t see why your shown code raise an "Object required" error.
This error would come up e.g. if you have a variable declared as String
and are trying to use it as an Object. If ts is declared as a Variant
that shouldn´t throw the error.

Please try:

Dim fso as Scripting.FileSystemObject
Dim f as Scripting.File
Dim ts as Scripting.TextStream

--
Viele Grüße
Michael Bauer


Michael,

Thanks for catching my typo. I changed objSelected to objSelection and
now the error appears at:
-----------
ts.Write strTitle & ">" & ">" & strFirstName & ">" & strLastName & ">"
& strEmail & ">" & _
strPass & ">" & strProf & ">" & strMedSpec & ">" & strHosp & ">" &
strCity & ">" & strState & ">" & strZip & ">" & strCountry & ">" &
strRegVia & ">" & strPromo
ts.WriteLine
ts.Close
-----------

Thanks for your patience.

Henry

}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}
 
H

hstockbridge5

Michael,

I got it FINALLY! For whatever reason, I had to move the following
code under the If..End If block:

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile("c:\Messages.txt") ', False)
Set ts = f.OpenAsTextStream(ForAppending, TristateUseDefault)

It worked like a charm. Thanks for your help. Your help has saved
hours upon hours of data entry work!

Henry

==============================================================
 
M

Michael Bauer

Hi Henry,

ok, now I see it: After the first writing to the Textstream you had
closed it.

So it works *and* is performant:

<snippet>
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile("c:\Messages.txt") ', False)
Set ts = f.OpenAsTextStream(ForAppending, TristateUseDefault)

For Each objMsg In objSelected
If typeOf objMsg is Outlook.MailItem Then
....
ts.write....
ts.writeline
Endif
Next

ts.Close
</snippet>


--
Viele Grüße
Michael Bauer


Michael,

I got it FINALLY! For whatever reason, I had to move the following
code under the If..End If block:

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile("c:\Messages.txt") ', False)
Set ts = f.OpenAsTextStream(ForAppending, TristateUseDefault)

It worked like a charm. Thanks for your help. Your help has saved
hours upon hours of data entry work!

Henry

==============================================================
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

ParseTextLinePair returns empty string 2
Message Parse to Access Database 5
Macro to populate contact fields no longer working 2
Form On Current question 2
Import Complex info from Excel via VBA 6
Code problem Help! 0
Access 2003 - Codes does not work now - Help 0
Single quotes in filter string, how to manage???? 0

Top