Extract Email Text to Excel

[bcloring]

Hello Rick,

I've tried everything I can think of with the code you provided to me, but I still end up with a Runtime Error (9) Subcript out of range. I thought it was because it wasn't finding the string Guest Information, but I changed the text file so it would find it and it still blows up on that statement.
Here is the code that you had me try:

Sub GetEmailInfo()
Dim X As Long, FilePathAndName As String, TotalFile As String, FileNum As Long, Arr() As String
Dim ReportDate As String, ReportNumber As String, StoreNumber As String, Issue As String

' Get path and filename by whatever means you do now
FilePathAndName = "c:\temp\Email Text.txt"

' Read entire file into TotalFile variable
FileNum = FreeFile
Open FilePathAndName For Binary As #FileNum
TotalFile = Space(LOF(FileNum))
Get #FileNum, , TotalFile
Close #FileNum
' Get Report Number
Arr = Split(TotalFile, "REPORT #: ")
ReportNumber = Val(Arr(1))

' Get Report Date
Arr = Split(TotalFile, "REPORTED: ")
ReportDate = Split(Arr(1), vbCrLf)(0)

' Get Store Number
Arr = Split(TotalFile, vbCrLf & "Store ")
StoreNumber = Val(Arr(1))

' Get Issue
Arr = Split(TotalFile, "ADDITIONAL COMMENTS:")
Arr = Split(Arr(1), vbCrLf, 3)
Arr = Split(Arr(2), vbCrLf & vbCrLf)
Issue = Arr(0)

' Let's see what we got
MsgBox "Report #: " & ReportNumber & vbLf & vbLf & _
"Report Date: " & ReportDate & vbLf & vbLf & _
"Stort #: " & StoreNumber & vbLf & vbLf & _
"Issue: " & Issue
End Sub

I'm not sure if you got the email samples that I emailed to you or not? I'm currently cut/pasting 200+ emails a day in Excel. There must be a faster way of doing this?
Any help you can give me would be greatly appreciated.

bcloring (Bob Loring) bcloring@gmail.com

[snb]

there surely is:


sub M_snb()
sn=split(createobject("scripting.filesystemobject").opentextfile("c:\temp\Email Text.txt").readall,vbcrlf)

for j=1 to 3
c01=c01 & vblf & join(filter(sn,choose(j,"report","store","comment"),vblf)
next

msgbox c01
End sub

[snb]

or

Sub M_snb()
sn = Split(CreateObject("scripting.filesystemobject").o pentextfile("c:\Users\bloring\Documents\ServiceChe ck\SC_EMAILS.txt").readall, vbCrLf & vbcrlf)

For j = 1 To 5
c01 = c01 & vbLf & Join(Filter(sn, Choose(j, "REPORT", "REPORTED", "Guest Information", "Restaurant Information", "ADDITIONAL COMMENTS"), vbLf))
Next

MsgBox c01
End Sub

[bcloring]

Hi snb,

I tried your modified code, but I get the same results: Run-Time error 13 Type Mismatch: When I click on DEBUG, this statement highlights. I'm not sure what I'm doing wrong?

c01 = c01 & vbLf & Join(Filter(sn, Choose(j, "REPORT", "REPORTED", "Guest Information", "Restaurant Information", "ADDITIONAL COMMENTS"), vbLf))

[Rick Rothstein]

Hello Rick,

I'm not sure if you got the email samples that I emailed to you or not? I'm currently cut/pasting 200+ emails a day in Excel. There must be a faster way of doing this?

Yes, I got your email. I don't know if you saw my "announcement" in my sub-forum, but I got new computer and before I could do anything, the old computer died. I am now trying to reestablish the data that didn't get fully backed up... that and personal commitments has not left me a lot of free time. I see snb has joined the thread... while you seem to be having problems with what he has posted so far, he is an excellent programmer who I am confident will get you on the right track. If I can steal a large enough block of time, I'll try to look at your question and jump back into the thread you two haven't worked out a solution in the meantime. Sorry to be putting you off, but getting my new computer set up is taking longer than I anticipated or wanted... plus I know you are in capable hands with snb, so I know you will have a solution soon enough.

[snb]

It's only a matter of brackets..


Sub M_stttys()
sn = Split(CreateObject("scripting.filesystemobject").opentextfile("G:\OF\__resto.txt").readall, vbCrLf)
For j = 1 To 2
c01 = c01 & vbLf & Join(Filter(sn, Choose(j, "Sent", "Subject")), vbLf)
Next
MsgBox c01
End Sub