Excel VBA to read log/text files

[tanhy]

Hi, I'm not well verse with VBA and like to request for great help to make a script.

I will like an Excel file (let’s call it Extractor.xlsm) that can read log files in subfolders in the same directory.

Directory Description:
Subfolders are named by year and the log files within each subfolder are named by date with this naming format: Log_yyyy-mm-dd.txt

Example of folder content:​

\2019\Log_2019-01-01.txt​

\2019\Log_2019-12-31.txt​

\2020\Log_2020-01-01.txt​

\2020\Log_2020-01-02.txt​

\2020\Log_2020-04-12.txt​

Extractor.xlsm​

Log File Description:
In each log file, there are a few lines of random text at the beginning. This is not constant.
Then a table. There isn’t anything after the table except for an empty newline.
The table has some heading, a dash line and the content. There will always be a dash line separating the heading and content. The dash line is unique in that it will be the first instance where more than 2 consecutive “-“ characters can be found.
Only the heading and table body should be transferred from the log file to the Excel sheet.
Example of the log file is shown below. The table has some random values but each column width is exactly as shown and will remain the same for all log files. The columns are separated by a minimum of 2 consecutive spaces.

Some text (this line present in all files); don't process this line; process table heading and body but not dash line
More text (this line not necessary present in all files); don't process this line

Proc     Cess        Head   Ing         But     Dont    Proc    Cess    Dash  Line   
-------------------------------------------------------------------------------------
A9HFS7   D-9930      DF8W   ABC123      123     456     01:10   02:26   123   9345   
SU38SF                      A343        0       0       02:35   03:22   492   8943   
SJ3SJ9   ABCD-12345  39D    93F039      25444   0       11:22   15:36   356   3842   
DIWEW8   243-45      R2                 -800    2243    14:33   15:38   546   5425   
2IS920                      00000000    93940   0       16:33   18:33   ???   ????   
S9829E   12-34       I899   RWE34       0       2345    20:22   23:22   486   4888

Excel File Description:
In the Excel sheet, cell L1 has a date.
When the cell L1 date value changes by user input, columns A to J should be automatically populated with the respective log file table heading and table body starting with the heading in row 1.
(For reference, manually, this is achieved by opening the desired log file, deleting the dash line row, copying the heading and table body to clipboard, select Excel sheet cell A1, then Paste using Text Import Wizard with Fixed Width option selected.)
Example of desired Excel output is shown below.
If a future date is entered and no log file is found, columns A to J should be blank with no other error pop-ups.

Proc​	Cess​	Head​	Ing​	But​	Dont​	Proc​	Cess​	Das​	Line​		12/4/2020​
A9HFS7	D-9930	DF8W	ABC123	123​	456​	1:10​	2:26​	123​	9345​		Above is cell L1
SU38SF			A343	0​	0​	2:35​	3:22​	492​	8943​
SJ3SJ9	E359ER	39D	93F039	25444​	0​	11:22​	15:36​	356​	3842​
DIWEW8	243-45	R2		-800​	2243​	14:33​	15:38​	546​	5425​
2IS920			0​	93940​	0​	16:33​	18:33​	???	????
S9829E	12-34​	I899	RWE34	0​	2345​	20:22​	23:22​	486​	4888​

Above is the main request.

Extra:
If the VBA script is flexible to accommodate the below it will be even better.

Older log files doesn’t have the second last column. Example shown below.
So columns A to I should be automatically populated leaving columns J blank.

Some text (this line present in all files); don't process this line; process table heading and body but not dash line
More text (this line not necessary present in all files); don't process this line

Proc     Cess        Head   Ing         But     Dont    Proc    Cess    Line   
-------------------------------------------------------------------------------
A9HFS7   D-9930      DF8W   ABC123      123     456     01:10   02:26   9345   
SU38SF                      A343        0       0       02:35   03:22   8943   
SJ3SJ9   ABCD-12345  39D    93F039      25444   0       11:22   15:36   3842   
DIWEW8   243-45      R2                 -800    2243    14:33   15:38   5425   
2IS920                      00000000    93940   0       16:33   18:33   ????   
S9829E   12-34       I899   RWE34       0       2345    20:22   23:22   4888

Thank you! ?

 

[Logit]

.
This will import text files into Excel. Presently, it is a manual method where the User selects the file / s to be imported. The code creates
a second workbook ... each text file appears on its own sheet in the new workbook. The code may be edited to make it an automated
process, etc.

Option Explicit

Sub CombineTextFiles()
    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String
    
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    
    sDelimiter = "|"
    
    FilesToOpen = Application.GetOpenFilename _
    (FileFilter:="Text Files (*.txt), *.txt", _
    MultiSelect:=True, Title:="Text Files to Open")
    
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If
    
    x = 1
    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
    wkbTemp.Sheets(1).Copy
    Set wkbAll = ActiveWorkbook
    wkbTemp.Close (False)
    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
    Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=False, Semicolon:=False, _
    Comma:=True, Space:=False, _
    Other:=True, OtherChar:=False
    x = x + 1
    
    While x <= UBound(FilesToOpen)
        Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
        With wkbAll
            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
            .Worksheets(x).Columns("A:A").TextToColumns _
            Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, _
            Tab:=False, Semicolon:=False, _
            Comma:=False, Space:=False, _
            Other:=True, OtherChar:=sDelimiter
        End With
        x = x + 1
    Wend
    
ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
    Set wkbTemp = Nothing
    Exit Sub
    
ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

 

[tanhy]

Thanks for responding so quickly. However, it appears very far from what I hope for and I have to admit I don't much good knowledge of VBA to make the huge changes required.

Most important how do I tweak this to follow the Text Import Wizard, Fixed Width option?
It appears to be currently using a delimiter and so this is not splitting up each rows into columns. I don't think even the space delimiter is a good option as there are blanks in certain table body cell which are currently filled with space.

 

[Logit]

Provide a sample copy of your TEXT file to work with. Let's see what can be done.

 

[tanhy]

A sample copy of the text file is provided in the first post. This forum doesn't seems to allow upload of files so I posted the text content as a code.

Anyway here it is again:

Text file to be read:

Some text (this line present in all files); don't process this line; process table heading and body but not dash line
More text (this line not necessary present in all files); don't process this line; process table heading and body but not dash line

Proc     Cess        Head   Ing         But     Dont    Proc    Cess    Dash  Line   
-------------------------------------------------------------------------------------
A9HFS7   D-9930      DF8W   ABC123      123     456     01:10   02:26   123   9345   
SU38SF                      A343        0       0       02:35   03:22   492   8943   
SJ3SJ9   ABCD-12345  39D    93F039      25444   0       11:22   15:36   356   3842   
DIWEW8   243-45      R2                 -800    2243    14:33   15:38   546   5425   
2IS920                      00000000    93940   0       16:33   18:33   ???   ????   
S9829E   1234-56     I899   RWE34       0       2345    20:22   23:22   486   4888

Desired output to Excel:

Proc​	Cess​	Head​	Ing​	But​	Dont​	Proc​	Cess​	Dash​	Line​	​	12/4/2020​
A9HFS7	D-9930	DF8W	ABC123	123​	456​	1:10​	2:26​	123​	9345​		Above cell is L1
SU38SF			A343	0​	0​	2:35​	3:22​	492​	8943​
SJ3SJ9	ABCD-12345	39D	93F039	25444​	0​	11:22​	15:36​	356​	3842​
DIWEW8	243-45	R2		-800​	2243​	14:33​	15:38​	546​	5425​
2IS920			0​	93940​	0​	16:33​	18:33​	???	????
S9829E	1234-56​	I899	RWE34	0​	2345​	20:22​	23:22​	486​	4888​

Please advise if this is adequate or if there is another method to upload files.

 

[tanhy]

Anyway to summarise the 1st post request - I'm hope for a VBA script that:

• Automate importing of dated-named text file base on user date input in cell L1
• Import text file content in same sheet column A to J
• Automatically refresh when every data input in cell L1 changes
• Do not import the first few lines before table heading
• Do not import the dash line between table heading and table body
• Load in fixed width format
• (Extra) Older text files doesn't have 2nd last column so if VBA script can still process this by importing text content in column A to I and leaving column J blank will be great

 

[Logit]

You can use a temp storage website like DROPBOX.COM or similar to post the text file.

I understand it is a 'text file' but attempting to recreate what is seen in your post may not actually provide an accurate representation. There may be something
unique about the formatting that isn't obvious. That is the reason for trying to work with an actual file. Thanks.

 

[tanhy]

Sure, please find sample file links below. Thank you!

1-off sample text file:
Log_2020-04-12

Sample of entire directory (with subfolders & text files of varying content):
Excel VBA Help

Was originally hesitant to upload in external storage links as users may not be able to download files from file-sharing sites or may be reluctant to download files for security reasons.

 

[rlv01]

This works when I run it against your posted data snippet.

Sub TextFileLoad()
    Dim WB As Workbook, WS As Worksheet
    Dim fname As String, Msg As String, Ext As String, TextLine As String, Ch As String
    Dim SA As Variant, IsTable As Boolean, IsHeader As Boolean
    Dim SPos As Long, RowIndx As Long, ColIndx As Long

    Set WB = ActiveWorkbook

    Msg = "Select File Containing the data"
    Ext = "txt"                                       ' file extension

    fname = Application.GetOpenFilename(Ext & " Files (*." & Ext & "), *." & Ext, 1, Msg)

    If fname = "False" Then                           'User cancel
        MsgBox "Canceled by user", vbCritical
        Exit Sub
    End If

    If (Dir$(fname) = "") Then                        'File not found
        MsgBox "File " & fname & " not found", vbCritical
        Exit Sub
    End If

    With WB
        Set WS = WB.Sheets.Add(After:=.Worksheets(.Worksheets.Count))    'add new worksheet
    End With

    Open fname For Input Access Read As #1            ' Open text file for read only.

    RowIndx = 0
    ColIndx = 1
    SPos = 1
    Do While Not EOF(1)                               ' Loop until end of file.
        Line Input #1, TextLine                       ' Read line of text into variable.
        '
        'Code to extract needed data and put it into worksheet cells goes here.
        '
        IsHeader = InStr(TextLine, "Proc ") = 1
        If IsHeader Then                              'found header
            RowIndx = RowIndx + 1
            IsTable = True
            SA = Split(Application.Trim(TextLine), " ")
            With WS.Range("A1")
                .EntireColumn.Resize(, UBound(SA) + 1).NumberFormat = "@"
                With .Resize(1, UBound(SA) + 1)
                    .Font.Bold = True
                    .Borders(xlEdgeBottom).Weight = xlMedium
                End With
            End With
            For ColIndx = LBound(SA) To UBound(SA)    'determine data column positions
                WS.Cells(RowIndx, ColIndx + 1) = SA(ColIndx)    '
                SA(ColIndx) = InStr(SPos, TextLine, SA(ColIndx))
                SPos = SA(ColIndx)
            Next ColIndx
        End If

        If TextLine = "" Then
            IsTable = False
        End If

        'extract data to worksheet cells
        If IsTable And Left(TextLine, 4) <> "----" And Not IsHeader Then    'found data
            RowIndx = RowIndx + 1
            For ColIndx = LBound(SA) To UBound(SA)
                Ch = Mid(TextLine, SA(ColIndx), 1)
                If Ch <> " " Then
                    WS.Cells(RowIndx, ColIndx + 1) = Split(Mid(TextLine, SA(ColIndx), Len(TextLine)))(0)
                End If
            Next ColIndx
        End If
        '
        'end data extract
        '
    Loop
    Close #1                                          ' Close file.
    WS.Columns.AutoFit
End Sub

 

[Logit]

Paste the following into a regular module. On the first sheet of your workbook paste a CommandButton and attach it to this macro.

The macro is dependent upon each Text File being identical to your example download. It can be as large (as many rows) as you want but
the top (first) five lines must always be as presented in your example post in your first post up top. That is :

1st Line Some Text : "Some text (this line present in all files); don't process this line; process table heading and body but not dash line"
2nd Line More Text : "More text (this line not necessary present in all files); don't process this line; process table heading and body but not dash line"
3rd Line Blank :
4th Line 10 Headers of Some Type : "Proc Cess Head Ing But Dont Proc Cess Dash Line "
5th Line Dashes : "-------------------------------------------------------------------------------------"

The macro processes the first five lines, moving some lines up, then it processes the remaining data below those five lines.


.

Option Explicit

Sub ImportTXTFiles()
    Dim importrow As Long
    Dim fso As Object
    Dim xlsheet As Worksheet
    Dim qt As QueryTable
    Dim txtfilesToOpen As Variant, txtfile As Variant

    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")

    txtfilesToOpen = Application.GetOpenFilename _
                 (FileFilter:="Text Files (*.txt), *.txt", _
                  MultiSelect:=True, Title:="Text Files to Open")

    With ActiveSheet

        For Each txtfile In txtfilesToOpen

            importrow = 1 + .Cells(.Rows.Count, 1).End(xlUp).Row
            
            With .QueryTables.Add(Connection:="TEXT;" & txtfile, _
              Destination:=.Cells(importrow, 1))
                .TextFileParseType = xlDelimited
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = False
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = False
                .TextFileOtherDelimiter = "|"
                .Refresh BackgroundQuery:=False
            End With


        Next txtfile

        For Each qt In .QueryTables
            qt.Delete
        Next qt

    End With
    
    Rows("1:4").Delete Shift:=xlUp
    Rows("2:2").Delete Shift:=xlUp
    
    Range("A:A").Select
    
    Selection.TextToColumns Destination:=Range("A1")
        
    Columns("A:A").EntireColumn.AutoFit
    Range("A1").Select
    Application.ScreenUpdating = True
    MsgBox "Done !", vbInformation, "SUCCESS !"

    Set fso = Nothing
End Sub