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