to copy selected data for selected dates from text to excel

Question

I am able to copy the data from Text file into the Excel file using below mentioned code. However I would like to ask if we can add the following options while copying data from text to excel.

1. If we can add an option where we can write the Text file name in the code as well. The reason is that there are multiple text files in a FolderLocation and i am not able to select the specific text file from which data needs to be copied.

2. Currently it copies all the data from text file, is there any way we can add a criteria or date option in the code so that rather than selecting all the data it could select the data for certain date(s). The data in the text file is like mentioned below

[03] Sat 07Jan23 10:10:58 - Initializing

[03] Sat 07Jan23 10:10:58 - Selected key

[03] Sat 07Jan23 10:10:58 - Host

[03] Sat 07Jan23 10:10:58 - Server

[03] Sat 07Jan23 10:10:58 - Client

[07] Tue 10Jan23 06:51:02 - SSH

[08] Tue 10Jan23 06:51:02 - SSH

03] Tue 10Jan23 06:51:02 -

[07] Tue 10Jan23 06:51:02 -

The data in the log file is for multiple dates, i wish if we can copy the data of certain dates, e.g. if i write "07Jan23" date in the code it only copies all the complete rows for 07Jan23.

Sub ImportTextFileDatatoExcel()

Dim fileLocation As String, textData As String

Dim rowNum As Long

folderLocation = "E:\Logs"

Set fso = CreateObject("Scripting.FileSystemObject")

Set folder = fso.GetFolder(folderLocation)

rowNum = 1

Close #1


For Each textFile In folder.Files

    fileLocation = folder & "\" & textFile.Name

    Open fileLocation For Input As #1

    Do While Not EOF(1)

        Line Input #1, textData

        textData = Replace(textData, ";", ",")

        If InStr(textData, ",") = 0 Then

            Cells(rowNum, 1) = textData

        Else

            tArray = Split(textData, ",")

            nColumn = 1

            For Each element In tArray
               

Cells(rowNum, nColumn) = element

                nColumn = nColumn + 1

            Next element

        End If

        rowNum = rowNum + 1

    Loop

    Close #1

Next textFile

End Sub

i shall remain thankful

Answer 1

Sub ImportTextFileDatatoExcel()

    Const LOGS = "E:\Logs"
    Const DBUG = False ' True for debug messages
    
    Dim wb As Workbook, ws As Worksheet
    Dim fso As Object, ts As Object, folder As Object, f As Object
    Dim dtFirst As Date, dtLast As Date, dt As Date
    Dim arFile, arLine, v, yy As String, mmm As String, dd As String
    Dim n As Long, i As Long, r As Long, c As Long, s As String
    
    s = InputBox("Enter Start Date dd/mm/yyyy", "Start Date", Format(Date, "dd/mm/yyyy"))
    If IsDate(s) Then
        dtFirst = CDate(s)
    Else
        MsgBox s & " is not a valid date", vbCritical
        Exit Sub
    End If
     
    s = InputBox("Enter End Date dd/mm/yyyy", "End Date", Format(dtFirst, "dd/mm/yyyy"))
    If IsDate(s) Then
        dtLast = CDate(s)
    Else
        MsgBox s & " is not a valid date", vbCritical
        Exit Sub
    End If
    
    s = "From " & Format(dtFirst, "dd mmm yyyy") & " to " & Format(dtLast, "dd mmm yyyy")
    If vbNo = MsgBox(s, vbYesNo, "Confirm Yes/No") Then
         Exit Sub
    End If
    
    ' start scanning logs
    Set wb = ThisWorkbook
    Set ws = wb.ActiveSheet
    ws.Cells.ClearContents
    r = 2
    
    ' select files
    Dim arLogs
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = LOGS
        .AllowMultiSelect = True
        .Filters.Add "Log files or Text", "*.log; *.txt, 1"
        .Show
        n = .SelectedItems.Count
        If n = 0 Then Exit Sub
        ReDim arLogs(1 To n)
        For i = 1 To n
            arLogs(i) = .SelectedItems(i)
        Next
    End With
    
    ' scan files
    Set fso = CreateObject("Scripting.FileSystemObject")
    For n = 1 To UBound(arLogs)
        Set f = fso.getFile(arLogs(n))
                
        ' read in file
        If DBUG Then Debug.Print f.Name
        Set ts = f.OpenAsTextStream(1, -2) ' read, default encoding
        s = ts.readall
        ts.Close
        
        ' scan each line
        arFile = Split(s, vbCrLf)
        For Each v In arFile
        
            ' convert 10Jan23 to 10-Jan-23
            s = Mid(CStr(v), 10, 7)
            dd = Left(s, 2)
            mmm = Mid(s, 3, 3)
            yy = Right(s, 2)
            s = dd & "-" & mmm & "-" & yy
           
            ' check valid date
            If IsDate(s) Then
                dt = CDate(s)
                If (dt >= dtFirst) And (dt <= dtLast) Then
                
                    ' split line into columns
                    arLine = Split(CStr(v), ";")
                    c = 1 + UBound(arLine)
                    ws.Cells(r, 1).Resize(, c) = arLine
                    r = r + 1
                    
                    If DBUG Then Debug.Print s, Format(dt, "yyyy-mm-dd"), v
                Else
                    If DBUG Then Debug.Print "outside range", s, v
                End If
                
            Else
                If DBUG Then Debug.Print "not a date", s, v
            End If
           
        Next
    Next
    ' result
    MsgBox n - 1 & " logs scanned. " & vbLf & _
           r - 2 & " lines extracted", vbInformation
    
End Sub