Extract Data VBA from thousands of .txt files (all have same fields) and paste into excel

[jarteaga]

Hi!

Could someone please help me,

I need to extract specific data from emails I have exported as .txt files and paste them into excel

This is an example of an email:

From: xxxxxxxxxxxxxxxxxxxxx
Sent: Friday, December 02, 2016 11:35 AM
To: xxxxxxxxxxxxxx
Cc: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Support
Subject: xxxxxxxxxxxxxxxxxxxxxxxxxxxxx
preparelaunch:xxxxxxxxxxxxxxxxxxxxxxxxxx

Dear User,

Please find the details of error event originated from application WILEYPLUS-ESB-APPLN below.


Error Details :
========================
Application ID : xxxxxxxxxxxxxxxx

Service Name : preparelaunch

Error Code : xxxxxxxxxxxxx

Error Description : xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Error Type : PROCESS_ERROR

Error GUID : edd72224-7324-4b02-9abf-1e73bc12b9c9

Error Event DateTime : 02-Dec-2016 16:33:24 GMT

Error Correlation ID : Correlation ID Not Sent

Error Stack :
---------------------------------
<Begin>

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

<End>

Business Key Details :
========================
The following business keys are sent by the application.


Server ID :1115
Root Cause :Undefined


Workflow Details :
========================
$WorkflowDetails

Error GUID : edd72224-7324-4b02-9abf-1e73bc12b9c9

Error Event DateTime : 02-Dec-2016 16:33:24 GMT

Payload Details :
========================
Message Data :
---------------------------------
<Begin>

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

<End>

Sincerely,

xxxxxxxxxxxxx Services Support Team


Note: This email is system generated hence do not reply to this mail. Please reach out to appropriate
support for further details or login to : xxxxxxxxxxxxxxx




The data I need is located here:


Error Details :
========================
Application ID : xxxxxxxxxxxxxxxx

Service Name : preparelaunch

Error Code : xxxxxxxxxxxxx

Error Description : xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Error Type : PROCESS_ERROR

Error GUID : edd72224-7324-4b02-9abf-1e73bc12b9c9

Error Event DateTime : 02-Dec-2016 16:33:24 GMT

Error Correlation ID : Correlation ID Not Sent

Error Stack :
---------------------------------

I just need to get that data (application ID, service name, error code etc....) so each text file would be one line in excel.

Thanks for your help!

 

[baitmaster]

welcome to the board

can you place a couple of sample emails on e.g. dropbox. Remove any confidential info but otherwise leave them untouched

 

[jarteaga]

welcome to the board

can you place a couple of sample emails on e.g. dropbox. Remove any confidential info but otherwise leave them untouched

Hi thanks for the reply,

Here is a folder with two emails, I already had them exported as .txt

https://1drv.ms/f/s!AhsCYPSFwRl0gas2QZcJcQpSN6DIow

 

[baitmaster]

This code in a general code module, in a workbook saved on your server. Next to this file is a folder named "emails". The code will open every .txt file in that folder and import the data requested. It will take a long time to run, for many files I'd leave it overnight - run it on a few files first just to test. It can't be sped up much because it involves opening files, which takes time. You're running the first macro "importFromAllFilesInFolder". I have a single worksheet set up with ten column headers, but it will run on a blank worksheet and you can add your own headers

Option Explicit
Dim arrResults()

Sub importFromAllFilesInFolder()
Dim lRow As Long
Dim srcFolder As String, sourceFileNames As String
Dim wbImport As Workbook
srcFolder = ThisWorkbook.Path & "\emails\"
sourceFileNames = Dir(srcFolder & "*.txt")
Do While sourceFileNames <> ""
    
    lRow = lastUsedRow(ActiveSheet) + 1
    Set wbImport = Workbooks.Open(srcFolder & sourceFileNames)
        
    openEmail
    
    wbImport.Close savechanges:=False
    
    Range(Cells(lRow, 1), Cells(lRow, 10)).Value = arrResults
    
    sourceFileNames = Dir
Loop
End Sub

Sub openEmail()
Dim i As Integer
Dim arrImportFields()
arrImportFields = Array("Application ID", "Service Name", "Error Code", _
                        "Error Description", "Error Type", "Error GUID", _
                        "Error Event DateTime", "Error Correlation ID", "Error Stack")
ReDim arrResults(LBound(arrImportFields) To UBound(arrImportFields) + 1)
arrResults(i) = ActiveWorkbook.Name
For i = LBound(arrImportFields) To UBound(arrImportFields)
    arrResults(i + 1) = getErrData(arrImportFields(i))
Next i
End Sub

Function getErrData(str)
Dim rngFind As Range, strData As String
On Error Resume Next
    Set rngFind = ActiveSheet.Cells.Find(str, ActiveSheet.Range("A1"), xlValues, xlPart)
On Error GoTo 0
If rngFind Is Nothing Then
    getErrData = "not found"
Else
    strData = rngFind.End(xlToRight).Value
    If Left(strData, 2) = ": " Then strData = Right(strData, Len(strData) - 2)
    getErrData = strData
End If
End Function

Function lastUsedRow(ws As Worksheet) As Long
On Error Resume Next
    lastUsedRow = ws.Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
On Error GoTo 0
End Function

 

[jarteaga]

This code in a general code module, in a workbook saved on your server. Next to this file is a folder named "emails". The code will open every .txt file in that folder and import the data requested. It will take a long time to run, for many files I'd leave it overnight - run it on a few files first just to test. It can't be sped up much because it involves opening files, which takes time. You're running the first macro "importFromAllFilesInFolder". I have a single worksheet set up with ten column headers, but it will run on a blank worksheet and you can add your own headers

Option Explicit
Dim arrResults()

Sub importFromAllFilesInFolder()
Dim lRow As Long
Dim srcFolder As String, sourceFileNames As String
Dim wbImport As Workbook
srcFolder = ThisWorkbook.Path & "\emails\"
sourceFileNames = Dir(srcFolder & "*.txt")
Do While sourceFileNames <> ""
    
    lRow = lastUsedRow(ActiveSheet) + 1
    Set wbImport = Workbooks.Open(srcFolder & sourceFileNames)
        
    openEmail
    
    wbImport.Close savechanges:=False
    
    Range(Cells(lRow, 1), Cells(lRow, 10)).Value = arrResults
    
    sourceFileNames = Dir
Loop
End Sub

Sub openEmail()
Dim i As Integer
Dim arrImportFields()
arrImportFields = Array("Application ID", "Service Name", "Error Code", _
                        "Error Description", "Error Type", "Error GUID", _
                        "Error Event DateTime", "Error Correlation ID", "Error Stack")
ReDim arrResults(LBound(arrImportFields) To UBound(arrImportFields) + 1)
arrResults(i) = ActiveWorkbook.Name
For i = LBound(arrImportFields) To UBound(arrImportFields)
    arrResults(i + 1) = getErrData(arrImportFields(i))
Next i
End Sub

Function getErrData(str)
Dim rngFind As Range, strData As String
On Error Resume Next
    Set rngFind = ActiveSheet.Cells.Find(str, ActiveSheet.Range("A1"), xlValues, xlPart)
On Error GoTo 0
If rngFind Is Nothing Then
    getErrData = "not found"
Else
    strData = rngFind.End(xlToRight).Value
    If Left(strData, 2) = ": " Then strData = Right(strData, Len(strData) - 2)
    getErrData = strData
End If
End Function

Function lastUsedRow(ws As Worksheet) As Long
On Error Resume Next
    lastUsedRow = ws.Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
On Error GoTo 0
End Function

Amazing, does exactly what i needed you are the best! Thank you!