Extract specific data from a folder of .eml files?

[tpir72]

Hi,
I have a folder of .eml files. They are an exported backup of my gmail account. Each .eml file is a separate email. They can be easily viewed with notepad.
I need to extract these four items. The format is always consistent mixed with other header and body info not needed.

Date:
Member logged in:
Email:
IP:

Date: Sat, 25 Feb 2012 19:25:24 -0700
Member logged in: somemember123
Email: name@gmail.com
IP: 83.121.245.221

Is there a way to scan this folder, have each email (one per row), with column data:

A1=Date:
A2=Member logged in:
A3=Email:
A4=IP:

Some emails may only have the Date: information. Is there a way to automate the process to scan the folder, only extract info if all four bits of information are available, add this data to one email message per row and ignore all other emails without all four bits of data present?

This is way over my head. I know some of you can come up with a formula in your sleep to do this.

I have thousands of emails to extract this data from.

Any help is sincerely appreciated.

Regards,

Terry

 

[Domenic]

You're welcome! Thanks for the feedback!

 

[tpir72]

Hi Dominic,
I just ran this on a different folder and got a runtime error 1004. In debug it had an issue with this line :

Cells(LastRow + 1, "a").Resize(UBound(MyArray, 2), UBound(MyArray, 1)).Value = WorksheetFunction.Transpose(MyArray)

Regards,

Terry

 

[Domenic]

When the error occurs and you click on 'Debug', enter the following in the Immediate Window (Ctrl+G)...

? LastRow

? UBound(MyArray,2)

What values do you get for the above?

 

[tpir72]

20217

 

[Domenic]

20217

Which one returns the above value? What about the other one, what does it return?

 

[Domenic]

For Excel 97 and later versions, the size of an array is limited to the available memory. For earlier versions, there may be a limit to the number of elements an array can hold. Therefore, here's a modified version of the macro I offered, which does not use an array...

[font=Courier New][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] test()

    [color=darkblue]Dim[/color] FSO [color=darkblue]As[/color] [color=darkblue]Object[/color]
    [color=darkblue]Dim[/color] TS [color=darkblue]As[/color] [color=darkblue]Object[/color]
    [color=darkblue]Dim[/color] MyPath [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] MyFile [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] strData [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] strDate [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] strMember [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] strEmail [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] strIP [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] NextRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] CountOfFields [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] CountOfEmails [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=darkblue]Set[/color] FSO = CreateObject("Scripting.FileSystemObject")
    
    MyPath = "C:\Users\Domenic\Desktop\" [color=green]'change the path to the folder accordingly[/color]
    
    MyFile = Dir(MyPath & "*.eml", vbNormal)
    
    NextRow = Cells(Rows.Count, "a").End(xlUp).Row + 1
    
    CountOfEmails = 0
    
    [color=darkblue]Do[/color] [color=darkblue]While[/color] Len(MyFile) > 0
    
        [color=darkblue]Set[/color] TS = FSO.OpenTextFile(MyPath & MyFile, 1, [color=darkblue]False[/color], -2)
        
        CountOfFields = 0
        [color=darkblue]Do[/color] [color=darkblue]Until[/color] TS.AtEndOfStream
            strData = TS.ReadLine
            [color=darkblue]If[/color] UCase(Left(strData, 5)) = "DATE:" [color=darkblue]Then[/color]
                CountOfFields = CountOfFields + 1
                strDate = Trim(Mid(strData, 6))
            [color=darkblue]ElseIf[/color] UCase(Left(strData, 17)) = "MEMBER LOGGED IN:" [color=darkblue]Then[/color]
                CountOfFields = CountOfFields + 1
                strMember = Trim(Mid(strData, 18))
            [color=darkblue]ElseIf[/color] UCase(Left(strData, 6)) = "EMAIL:" [color=darkblue]Then[/color]
                CountOfFields = CountOfFields + 1
                strEmail = Trim(Mid(strData, 7))
            [color=darkblue]ElseIf[/color] UCase(Left(strData, 3)) = "IP:" [color=darkblue]Then[/color]
                CountOfFields = CountOfFields + 1
                strIP = Trim(Mid(strData, 4))
            [color=darkblue]End[/color] [color=darkblue]If[/color]
            [color=darkblue]If[/color] CountOfFields = 4 [color=darkblue]Then[/color]
                CountOfEmails = CountOfEmails + 1
                Cells(NextRow, "a") = strDate
                Cells(NextRow, "b") = strMember
                Cells(NextRow, "c") = strEmail
                Cells(NextRow, "d") = strIP
                NextRow = NextRow + 1
                [color=darkblue]Exit[/color] [color=darkblue]Do[/color]
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]Loop[/color]
        
        TS.Close
                
        MyFile = Dir
        
    [color=darkblue]Loop[/color]
    
    [color=darkblue]If[/color] CountOfEmails = 0 [color=darkblue]Then[/color] MsgBox "No data was available...", vbExclamation
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]

 

[tpir72]

Thank you very much Dominic! I'll try this later tonight.

Thank you again very much.

Regards,

Terry

 

[tpir72]

Dominic,
Could I please ask in a slightly related question? All the data that I have successfully extracted for date/time is in one column in this format:


Sat, 16 Oct 2010 19:32:51
Mon, 14 Feb 2011 09:05:14
Mon, 14 Feb 2011 09:05:14
Sat, 22 Jan 2011 16:52:24
Sun, 19 Dec 2010 16:05:56

Is there a formula that could convert it to this format:

10/16/2010 19:24
2/14/2011 9:05
2/14/2011 9:05
1/22/2011 16:52
12/19/2010 16:05

I tried a simple format cells on that column and nothing changed.

Thank you very much for the help.

Regards,

Terry

 

[Domenic]

Try replacing...

strDate = Trim(Mid(strData, 6))

with

strDate = Trim(Mid(strData, InStr(1, strData, ",") + 1))

...and format the column as desired.

 

[tpir72]

Hey Dominic,
I'll try and let you know.

Regards,

Terry