Search code examples
excelvba

Excel VBA Selecting the files xxx_Before.log then xxx_After.log


Main goal is to select Tag1_Before Test1.log then Tag1_After Test 1.log and continue on to Tag2_Before Test1.log and then Tag2_After Test1.log and will continue for subsequent files. There can be Tag1_Before Test2.log and the Tag index number can be greater than 9. There won't be "Tag1_After2.log" (The name of the files will be different but there will definitely have a before or after in the name of the files). Currently the files are being selected in alphabetical order because I am using the Dir function. Below is part of the code I have gathered, and a visual representation of where I will access the files.

        With Application.FileDialog(msoFileDialogFilePicker)
            .AllowMultiSelect = False
            .Filters.Add "Log Files", "*.log", 1
        
            If .Show = -1 Then
                FullPath = .SelectedItems.Item(1) 'selected text file full path
            End If
        End With
        
        If FullPath = "" Then Exit Sub 'if Cancel pressed, the code stops
        
        textFileLocation = Left(FullPath, InStrRev(FullPath, "\") - 1)
        fileName = Dir(textFileLocation & "\*.log") 'first text file  name
        fileDate = Format(FileDateTime(textFileLocation), "mm/dd/yyyy")
      
      If fileName <> "" Then
        Do While fileName <> "" 'loop since there still are not processed text files
            'Get File Name
            sFullFilename = Right(fileName, Len(fileName) - InStrRev(fileName, "\"))
            sFileName = Left(sFullFilename, (InStr(sFullFilename, ".") - 1))
            
            'place the content of the text file in an array (split by VbCrLf):
            arrTxt = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(textFileLocation & "\" & fileName, 1).ReadAll, vbCrLf)
            lastR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row 'the row where to paste the array content
    
            'drop the transposed array content:
            ws.Range("A" & IIf(lastR = 1, lastR, lastR + 1)).Resize(UBound(arrTxt) + 1, 1).Value = Application.Transpose(arrTxt)
            
            'apply TextToColumns to whole returned data:
            ws.Columns(1).TextToColumns Destination:=ws.Range("A1"), DataType:=xlFixedWidth, _
            FieldInfo:=Array(Array(0, 1), Array(43, 1), Array(70, 1)), TrailingMinusNumbers:=True

Files


Solution

  • Please, test the next way. It extracts an array of all log files from the chosen folder, then reorder the respective array as necessary (before being first). After that, processing each array element as in your code:

    Sub ProcessingLogFiles()
      Dim textFileLocation As String, fileName As String, ws As Worksheet, lastR As Long
      Dim arrTxt, FullPath As String
      
      Set ws = Application.ActiveSheet 'use here the sheet you need
     'adapted to see the files:________________________________________
      With Application.FileDialog(msoFileDialogFilePicker)
            .AllowMultiSelect = False
            .Filters.Add "Log Files", "*.log", 1
            If .Show = -1 Then
                 FullPath = .SelectedItems.Item(1) 'selected log file full path
            End If
      End With
      If FullPath = "" Then Exit Sub 'if Cancel pressed, the code stops
      '________________________________________________________________
    
      textFileLocation = Left(FullPath, InStrRev(FullPath, "\")) 'extract folder name, backslash included
      
      Dim arrFiles
      arrFiles = getLogFiles(textFileLocation, "*.log*") 'get log files array
      
      If IsArray(arrFiles) Then 'if arrFiles is an array (of log files):
        arrFiles = getReorederedArray(arrFiles) 'reorder the array in the necessary way (before being first)
        'Debug.Print Join(arrFiles, "|"): Stop
      ElseIf arrFiles = "xxx" Then
         MsgBox "Different number of ""before"" files than ""after""...": Exit Sub
      Else
         Debug.Print "Unknown error...": Exit Sub
      End If
      
      Dim El
      For Each El In arrFiles 'iterate between reordered array elements:
         arrTxt = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(El, 1).ReadAll, vbCrLf)
         lastR = ws.Range("A" & ws.rows.count).End(xlUp).row 'the row where to paste the array content
        
        'drop the transposed array content:
        ws.Range("A" & IIf(lastR = 1, lastR, lastR + 1)).Resize(UBound(arrTxt) + 1, 1).Value = Application.Transpose(arrTxt)
      Next El
      
      'apply TextToColumns to whole returned data:
      ws.Columns(1).TextToColumns Destination:=ws.Range("A1"), DataType:=xlFixedWidth, _
           FieldInfo:=Array(Array(0, 1), Array(43, 1), Array(70, 1)), TrailingMinusNumbers:=True
    End Sub
    
    Private Function getLogFiles(strFold As String, Optional strExt As String = "*.*") As Variant
        getLogFiles = filter(Split(CreateObject("wscript.shell").exec("cmd /c dir """ & strFold & strExt & """ /b/s").StdOut.ReadAll, vbCrLf), "\")
    End Function
    Private Function getReorederedArray(arr) As Variant
      Dim arrAft: arrAft = filter(arr, "_After", True)
      Dim arrBef: arrBef = filter(arr, "_Before", True)
      
      If UBound(arrAft) <> UBound(arrBef) Then
        getReorederedArray = "xxx": Exit Function
      End If
         Dim arrWork, i As Long, k As Long
         ReDim arrWork(UBound(arrBef) + UBound(arrAft) + 1)
         For i = 0 To UBound(arrBef)
            arrWork(k) = arrBef(i): k = k + 1
            arrWork(k) = arrAft(i): k = k + 1
         Next i
        getReorederedArray = arrWork
    End Function
    

    The code not tested, not having such log files and no availability to build a specific testing environment, but it should work, I think... I tested only the part reordering the array.

    Please, send some feedback after testing it.