excelvbafilesystemobject

to copy selected data for selected dates from text to excel


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


Solution

  • 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