Excel VBA to read log/text files

tanhy

New Member
Joined
Mar 25, 2020
Messages
10
Office Version
  1. 2016
Platform
  1. Windows
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.
Code:
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​
A9HFS7D-9930DF8WABC123
123​
456​
1:10​
2:26​
123​
9345​
Above is cell L1
SU38SFA343
0​
0​
2:35​
3:22​
492​
8943​
SJ3SJ9E359ER39D93F039
25444​
0​
11:22​
15:36​
356​
3842​
DIWEW8243-45R2
-800​
2243​
14:33​
15:38​
546​
5425​
2IS920
0​
93940​
0​
16:33​
18:33​
???????
S9829E
12-34​
I899RWE34
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.
Code:
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! ?
 
Many thanks rlv01 & Logit for the help! This is most appreciated. ?
 
Upvote 0

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
This works when I run it against your posted data snippet.
VBA Code:
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

Wow this works beautifully! Appreciate the comments too. Many thanks! :love:

One final question:
Can this script be adjusted to accommodate non-consecutive single space in the header?
The headers are still separated from each other by a minimum of 2 consecutive spaces.

For example in this text file where the 4th column header is "Script No":
Rich (BB code):
Proc     Cess        Head   Script No   But     Dont    Proc    Cess    Dash  Line   
A9HFS7   D-9930      DF8W   ABC1234     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


I would like the output in Excel be as such:
Proc​
Cess​
Head​
Script No​
But​
Dont​
Proc​
Cess​
Dash​
Line​
A9HFS7D-9930DF8WABC1234
123​
456​
1:10​
2:26​
123​
9345​
SU38SFA343
0​
0​
2:35​
3:22​
492​
8943​
SJ3SJ9ABCD-1234539D93F039
25444​
0​
11:22​
15:36​
356​
3842​
 
Upvote 0
Can this script be adjusted to accommodate non-consecutive single space in the header?
The headers are still separated from each other by a minimum of 2 consecutive spaces.

If you have a list of expected 2-word headers, then that's an easy change to make. If you are talking about random 2-word headers unknown in advance, that would require major alterations.
 
Upvote 0
If you have a list of expected 2-word headers, then that's an easy change to make. If you are talking about random 2-word headers unknown in advance, that would require major alterations.
I see. Ok, I have a list of expected 2-word headers - "Script No" & "User ID".
 
Upvote 0
Try this
VBA Code:
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, S 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
            'process header
            S = Replace(RTrim(TextLine), "  ", "@@")
            Do While InStr(S, "@ ") > 0
                S = Replace(S, "@ ", "@@")
            Loop
            TextLine = Replace(Replace(S, " ", "_"), "@", " ")
            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) = Replace(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
                    S = Mid(TextLine, SA(ColIndx), Len(TextLine))
                    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
    MsgBox "Done"
End Sub
 
Upvote 0
Solution
Hey guys, first time posting on here.
I would have created a new thread, however, I think the solution I'm looking for is extremely close to what has already been suggested by @rlv01.

I tried tweaking the code to work on my sheet, however, it turns up an empty worksheet.

My requirements are as follows:
1. Need the information from the 'Project', 'Total' and 'Project Description' columns
2. (BONUS REQUIREMENT, not a dealbreaker) Be able to select multiple .txt files (all with the exact same formatting, just different line items under the columns) and be able to add all the content from various files into the same worksheet.

Really appreciate any help in sussing this out. Thanks!

Please refer to the data snippet below:

Code:
Run Date: 04/25/21                                                                XXXXXX, Inc                                                                 Run Time: 11:02 PM
                                                                      ETS Timesheet for Invoice Support 11.5.10

 Employee Timesheet for:  XYZ                                            DEN#:  000200335                                                        Period End Date: 23-APR-21


             ********************************************************************   Assignments   *********************************************************************
             * Company  :  0341     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX                              Work Week:                                                       *
             * Perf Unit:  004546   XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX                         Overtime Status:  Premium Overtime                                     *
             * Dept     :  0000      GENERAL                                                        Supervisor:  XXXXXXXXXXXX                                         *
             * Function :  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX                        Check Sort:  XXXXX                                                *
             **********************************************************************************************************************************************************

 Comment:

                                                   Apr    Apr    Apr    Apr    Apr    Apr    Apr    Apr
                                                   16     17     18     19     20     21     22     23
 Project     WBS/Task         Type       B/N       Fri    Sat    Sun    Mon    Tue    Wed    Thu    Fri     Total   Dept  Func  Shift  Project Description
 ----------- ---------------- ---------  ---      -----  -----  -----  -----  -----  -----  -----  -----    -----   ----  ----  -----  --------------------------------------------
 87F15600    INT_SYSTEMS      REGULAR PAY B                                                         1.00     1.00                      Various IPDS Projects – Internal and Extern
 IA245100    A.P2.PM.0005     REGULAR PAY B                             6.00   5.50   7.50   8.00   7.00    34.00                      Papakura to Pukekohe Electrification
 IS311800    A.CS.EL.PM.OM    REGULAR PAY B                             1.00    .50    .50                   2.00                      Planning and Environmental Approvals
 IS360300    A.CS.PM.CM.PM    REGULAR PAY B                             1.00                                 1.00                      Project Marinus - Service Order No 1: Mobil
 IS371000    A.CS.EV.PM_WWOA  REGULAR PAY B                                    2.00                          2.00                      VMFRP Environmental & Planning Approval del

                                                  -----  -----  -----  -----  -----  -----  -----  -----    -----
                                TOTAL                                   8.00   8.00   8.00   8.00   8.00    40.00

                                                                                          Total Regular:    40.00
                                                                                         Total OverTime:





 Timesheeet Submitted by :  XXXXXXXXXXX                     on 22-APR-2021 at 23:11:00 PM Pacific Time
 Timesheet Approved by :    XXXXXXXXXXXX                    on 23-APR-2021 at 04:25:51 AM Pacific Time


 Timesheet Approved by:
                            -------------------------

 Adjustment For Period End Date  23-APR-21


 Project  WBS/Task        Type     B/N Adjustment By                                                        Adjustment Type  Total   Func  Shift Project Description
 -------- --------------- --------- -- -------------------------                                            ---------------- ------- ----- ----- ---------------------------------
                                                                                                              Total Adjustm  + 0.00
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top