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

1

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.

6

The GetSortedLogFiles function returns a Collection of log files from a specified folder, filtered to include only files whose names contain “after” or “before.” The files are sorted in two steps:

By the “after”/”before” part of the filename, with “after” files listed before “before” files.
By numeric values extracted from the filenames, in ascending order.
This results in a collection of files, first sorted by status (after/before) and then by numbers in the file names.

Important

You will need to add to the Microsoft Scripting Runtime

  1. Open your VBA editor:

    • In Excel (or other Office applications), press Alt + F11 to open the Visual Basic for Applications (VBA) editor.
  2. Open the References window:

    • In the VBA editor, go to the menu at the top and click on Tools, then select References....
  3. Find the ‘Microsoft Scripting Runtime’ reference:

    • In the References window, scroll down until you find Microsoft Scripting Runtime. The library is associated with the Scripting.FileSystemObject and provides file system access.
    • The full name is typically Microsoft Scripting Runtime.
  4. Enable the reference:

    • Check the box next to Microsoft Scripting Runtime to enable it.
  5. Click OK:

    • Once selected, click OK to add the reference to your project.
  6. Verify:

    • You should now be able to use the Scripting.FileSystemObject and related objects like Folder and File without any issues.

Adding a reference to Microsoft Scripting Runtime enables intellisense to get us information about the files.

Sub Test()
    Rem Declare a Collection to hold sorted log files
    Dim Col As Collection
    Rem Get sorted log files from the specified folder path
    Set Col = GetSortedLogFiles("C:UsersuserDocumentsLog")
    
    Rem Declare a File variable
    Dim f As File
    
    Rem Iterate through each file in the collection
    For Each f In Col
        Rem Print the file name and date properties to the Debug window
        Debug.Print f.Name; " | "; f.DateLastAccessed; " | "; f.DateCreated; " | "; f.DateLastModified
        
        Rem Open the file as a text stream for reading
        With f.OpenAsTextStream(ForReading)
            Rem Print the contents of the file to the Debug window
            Debug.Print .ReadAll
            Rem Close the text stream after reading
            .Close
        End With
    Next
End Sub

Function GetSortedLogFiles(FolderPath As String) As Collection
    Rem Declare a new Collection to store log files
    Dim Col As New Collection
    Rem Declare a FileSystemObject to interact with the file system
    Dim FSO As New Scripting.FileSystemObject
    Rem Declare a File variable
    Dim f As File
    
    Rem Iterate through all files in the specified folder
    For Each f In FSO.GetFolder(FolderPath).Files
        Rem If the file name contains "after" or "before" (case-insensitive), add it to the collection
        If LCase(f.Name) Like "*after*.log" Or LCase(f.Name) Like "*before*.log" Then Col.Add f
    Next
    
    Rem Declare a 2D array to store sorting data (filename numbers, "after"/"before" status, file object)
    Dim Result
    ReDim Result(1 To Col.Count, 1 To 3)
    
    Dim n As Long
    Rem Populate the array with the relevant information for sorting
    For Each f In Col
        n = n + 1
        Rem Extract numbers from the file name for sorting purposes
        Result(n, 1) = ExtractNumbers(f.Name)
        Rem Determine if the file is "after" or "before" and store it
        Result(n, 2) = IIf(InStr(LCase(f.Name), "after"), "after", "before")
        Rem Store the file object itself
        Set Result(n, 3) = f
    Next
    
    Rem Sort the array first by the "after"/"before" column (2nd column) in descending order
    Result = WorksheetFunction.Sort(Result, 2, -1)
    Rem Then sort the array by the extracted numbers (1st column) in ascending order
    Result = WorksheetFunction.Sort(Result, 1, 1)
    
    Rem Reinitialize the collection to store the sorted files
    Set Col = New Collection
    
    Rem Rebuild the collection in the sorted order
    For n = 1 To UBound(Result)
        Col.Add FSO.GetFile(Result(n, 3))
    Next
    
    Rem Return the sorted collection
    Set GetSortedLogFiles = Col
End Function

Function ExtractNumbers(InputString As String) As String
    Rem Declare variables
    Dim i As Integer
    Dim Result As String
    Result = ""

    Rem Loop through each character in the string
    For i = 1 To Len(InputString)
        Rem Check if the character is a number (0-9)
        If IsNumeric(Mid(InputString, i, 1)) Then
            Rem If it is a number, append it to the result string
            Result = Result & Mid(InputString, i, 1)
        End If
    Next i

    Rem Return the string of numbers extracted from the input string
    ExtractNumbers = Result
End Function

Result:

If Tag1 doesn’t need to appear before Tag2, you can gather all the log files into an array and then list the files in reverse order.

Option Explicit
Sub ListLogFiles()
    Dim folderPath As String
    Dim fileName As String
    Dim fileList() As String
    Dim fileCount As Long
    Dim i As Long
    folderPath = "D:Temp" ' Specify your folder path
    fileCount = 0
    ' search file with Dir
    fileName = Dir(folderPath & "*.log")
    ' Loop through all .log files
    Do While fileName <> ""
        fileCount = fileCount + 1
        ReDim Preserve fileList(1 To fileCount)
        fileList(fileCount) = fileName
        fileName = Dir ' Get the next file
    Loop
    ' If there are files, list files in reverse order
    If fileCount > 0 Then
        ' Reverse list
        For i = UBound(fileList) To LBound(fileList) Step -1
            Debug.Print fileList(i)
            ' Add your code to precess log file
            ' ***
        Next i
    Else
        Debug.Print "No log files found in " & folderPath
    End If
End Sub

Output in Immediate Window

Tag2_Before.log
Tag2_After.log
Tag1_Before.log
Tag1_After.log

Question: if tag1 need to appear before tag2 do you know if there is a way to do it?

Note: The script below is only a demonstration and has been tested based on the scenario outlined in the original post (OP). Revisions will be necessary if the log file names are more complex.

Option Explicit

Sub ListLogFiles()
    Dim folderPath As String
    Dim fileName As String
    Dim fileList() As String
    Dim fileCount As Long
    Dim i As Long
    folderPath = "D:Temp" ' Specify your folder path
    fileCount = 0
    ' search file with Dir
    fileName = Dir(folderPath & "*.log")
    ' Loop through all .log files
    Do While fileName <> ""
        fileCount = fileCount + 1
        ReDim Preserve fileList(1 To fileCount)
        fileList(fileCount) = fileName
        fileName = Dir ' Get the next file
    Loop
    ' If there are files, list files in reverse order
    If fileCount > 0 Then
        ' ** sort log file list
        SortLog fileList
        For i = LBound(fileList) To UBound(fileList)
            Debug.Print fileList(i)
            ' Add your code to precess log file
            ' ***
        Next i
    Else
        Debug.Print "No log files found in " & folderPath
    End If
End Sub

Sub SortLog(ByRef aFile() As String)
    Dim i As Long, j As Long, tmp As String
    Const B_TAG = "Before"
    Const B_TMP_TAG = "Aefore"
    ' replace Before with Aefore
    For i = LBound(aFile) To UBound(aFile)
        aFile(i) = Replace(aFile(i), B_TAG, B_TMP_TAG, , , vbTextCompare)
    Next
    ' bubble sorting
    For i = LBound(aFile) To UBound(aFile) - 1
        For j = i + 1 To UBound(aFile)
            If aFile(i) > aFile(j) Then
                tmp = aFile(i)
                aFile(i) = aFile(j)
                aFile(j) = tmp
            End If
        Next
    Next
    ' restore files name 
    For i = LBound(aFile) To UBound(aFile)
        aFile(i) = Replace(aFile(i), B_TMP_TAG, B_TAG, , , vbTextCompare)
    Next
End Sub

2

Identify File Sets

Immediate Window

Processing 1. File Set:
    Processing file: C:TestA_After.log
    Processing file: C:TestA_Before.log
Processing 2. File Set:
    Processing file: C:Testc_After.log
    Processing file: C:Testc_Before.log

Main

Sub ProcessBeforeAfter()
    
    ' Your preceding code...
    Dim ws As Worksheet: ' ...
    
    
    ' Let the user select the folder.
    Dim FolderPath As Variant
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:Test"
        If .Show = -1 Then
            FolderPath = .SelectedItems.Item(1)
        End If
    End With
    If FolderPath = "" Then Exit Sub 'if Cancel pressed, the code stops
    
    ' Create a reference to the 'FileSystemObject' object.
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' Return the file paths in an array.
    Dim FilePaths() As Variant: FilePaths = GetFilePaths(FolderPath, fso)
    
    ' Check if any file sets.
    If IsEmpty(FilePaths) Then
        MsgBox "No file sets found in folder """ & FolderPath _
            & """!", vbExclamation
        Exit Sub
    End If
       
    ' Use the information (file paths) in the array to build the rest
    ' of your code, e.g.:
       
    ' Retrieve the counts.
    Dim SetsCount As Long: SetsCount = UBound(FilePaths, 1)
    Dim IDsCount As Long: IDsCount = UBound(FilePaths, 2)
    
    ' Declare addtional variables.
    Dim r As Long, c As Long, sFileName As String
    
    ' List the file paths by sets (rows) in the Immediate window ('Ctrl+G').
    For r = 1 To SetsCount
        Debug.Print "Processing " & r & ". File Set:"
        For c = 1 To IDsCount
            Debug.Print vbTab & "Processing file: " & FilePaths(r, c)
            
            ' e.g.:
            'ProcessSingleFile FilePaths(r, c), ws, fso
        
        Next c
    Next r
    
    MsgBox "Files processed.", vbInformation
    
End Sub

Help: Process Single File

Sub ProcessSingleFile( _
        ByVal TextFilePath As String, _
        ByVal ws As Worksheet, _
        ByVal fso As Object)
    
    ' Return each line of the text file in an element of an array.
    Dim TextLines() As String
    With fso.OpenTextFile(TextFilePath, ForReading)
        TextLines = Split(.ReadAll, vbCrLf)
        .Close ' don't forget to close it!
    End With
    
    ' Reference the top-left cell.
    ' (Assuming the first drop will have at least two rows.)
    Dim fcell As Range: Set fcell = ws.Cells(ws.Rows.Count, "A").End(xlUp)
    If fcell.Row > 1 Then Set fcell = fcell.Offset(1)
        
    ' Copy the values to the sheet.
    ' (Note that there is a limitation of 65535 elements (per dimension)
    ' for the 'Transpose' function to work correctly.)
    Dim RowsCount As Long: RowsCount = UBound(TextLines) + 1
    fcell.Resize(RowsCount).Value = Application.Transpose(TextLines)

    ' Apply 'TextToColumns' to the copied data.
    fcell.Resize(RowsCount).TextToColumns _
        Destination:=fcell, _
        DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(43, 1), Array(70, 1)), _
        TrailingMinusNumbers:=True

End Sub

Help: Get File Paths

Function GetFilePaths( _
    ByVal FolderPath As String, _
    ByVal fso As Object) _
As Variant
    
    ' The idea is to populate a 2D one-based with the required file paths.
    ' The array will have as many columns as there are elements in 'FILE_IDS'
    ' and as many rows as the number of file sets. While looping through
    ' the files, a dictionary will keep track of the information.
    ' The keys of the dictionary will hold each file identifier
    ' i.e. the file's base name where the matching element in 'FILE_IDS'
    ' was replaced with 'FILE_ID_REPLACEMENT'. Each corresponding item
    ' will hold a zero-based count to be evaluated when building the array.
    
    ' Define constants.
    
    Const SRC_FILE_EXTENSION As String = "log"
    Dim FILE_IDS() As Variant: FILE_IDS = VBA.Array("After", "Before")
    Const FILE_ID_REPLACEMENT As String = "" ' '' is illegal for a file name
        
    ' Return the information in the dictionary.
        
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    ' Retrieve the upper limit of the file IDs.
    Dim iUpper As Long: iUpper = UBound(FILE_IDS)
    
    ' Declare additional variables
    Dim fsoFile As Object, i As Long, SetsCount As Long
    Dim sFilePath As String, sBaseName As String, sFileExtension As String
    Dim rFileName As String
    Dim HasRequiredExtension As Boolean, IsFileIdFound As Boolean
    
    For Each fsoFile In fso.GetFolder(FolderPath).Files
        sFilePath = fsoFile.Path
        sFileExtension = fso.GetExtensionName(sFilePath)
        HasRequiredExtension = False ' reset on each iteration
        If StrComp(sFileExtension, SRC_FILE_EXTENSION, vbTextCompare) = 0 Then
            HasRequiredExtension = True
        End If
        IsFileIdFound = False ' reset on each iteration
        If HasRequiredExtension Then
            sBaseName = fso.GetBaseName(sFilePath)
            For i = 0 To iUpper
                If InStr(1, sBaseName, FILE_IDS(i), vbTextCompare) > 0 Then
                    IsFileIdFound = True
                    Exit For
                End If
            Next i
        End If
        If IsFileIdFound Then
            rFileName = Replace(sBaseName, FILE_IDS(i), _
                FILE_ID_REPLACEMENT, , , vbTextCompare)
            If dict.Exists(rFileName) Then
                dict(rFileName) = dict(rFileName) + 1
                If dict(rFileName) = iUpper Then
                    SetsCount = SetsCount + 1
                End If
            Else
                dict(rFileName) = 0
            End If
        End If
    Next fsoFile
                
    ' Check if no file sets found.
    If SetsCount = 0 Then Exit Function
    
    ' For each found file set, return its file paths in a row
    ' of the 2D one-based array.
    
    ' Define the array.
    Dim IDsCount As Long: IDsCount = iUpper + 1
    Dim Data() As Variant: ReDim Data(1 To SetsCount, 1 To IDsCount)
    
    ' Declare addtional variables.
    Dim Item As Variant, r As Long, c As Long, sFileName As String
    
    ' Populate the array.
    For Each Item In dict.Keys
        If dict(Item) = iUpper Then
            r = r + 1
            For c = 1 To IDsCount
                sFileName = Replace(Item, FILE_ID_REPLACEMENT, _
                    FILE_IDS(c - 1)) & "." & SRC_FILE_EXTENSION
                Data(r, c) = fso.BuildPath(FolderPath, sFileName)
            Next c
        End If
    Next Item

    GetFilePaths = Data

End Function

Trang chủ Giới thiệu Sinh nhật bé trai Sinh nhật bé gái Tổ chức sự kiện Biểu diễn giải trí Dịch vụ khác Trang trí tiệc cưới Tổ chức khai trương Tư vấn dịch vụ Thư viện ảnh Tin tức - sự kiện Liên hệ Chú hề sinh nhật Trang trí YEAR END PARTY công ty Trang trí tất niên cuối năm Trang trí tất niên xu hướng mới nhất Trang trí sinh nhật bé trai Hải Đăng Trang trí sinh nhật bé Khánh Vân Trang trí sinh nhật Bích Ngân Trang trí sinh nhật bé Thanh Trang Thuê ông già Noel phát quà Biểu diễn xiếc khỉ Xiếc quay đĩa Dịch vụ tổ chức sự kiện 5 sao Thông tin về chúng tôi Dịch vụ sinh nhật bé trai Dịch vụ sinh nhật bé gái Sự kiện trọn gói Các tiết mục giải trí Dịch vụ bổ trợ Tiệc cưới sang trọng Dịch vụ khai trương Tư vấn tổ chức sự kiện Hình ảnh sự kiện Cập nhật tin tức Liên hệ ngay Thuê chú hề chuyên nghiệp Tiệc tất niên cho công ty Trang trí tiệc cuối năm Tiệc tất niên độc đáo Sinh nhật bé Hải Đăng Sinh nhật đáng yêu bé Khánh Vân Sinh nhật sang trọng Bích Ngân Tiệc sinh nhật bé Thanh Trang Dịch vụ ông già Noel Xiếc thú vui nhộn Biểu diễn xiếc quay đĩa Dịch vụ tổ chức tiệc uy tín Khám phá dịch vụ của chúng tôi Tiệc sinh nhật cho bé trai Trang trí tiệc cho bé gái Gói sự kiện chuyên nghiệp Chương trình giải trí hấp dẫn Dịch vụ hỗ trợ sự kiện Trang trí tiệc cưới đẹp Khởi đầu thành công với khai trương Chuyên gia tư vấn sự kiện Xem ảnh các sự kiện đẹp Tin mới về sự kiện Kết nối với đội ngũ chuyên gia Chú hề vui nhộn cho tiệc sinh nhật Ý tưởng tiệc cuối năm Tất niên độc đáo Trang trí tiệc hiện đại Tổ chức sinh nhật cho Hải Đăng Sinh nhật độc quyền Khánh Vân Phong cách tiệc Bích Ngân Trang trí tiệc bé Thanh Trang Thuê dịch vụ ông già Noel chuyên nghiệp Xem xiếc khỉ đặc sắc Xiếc quay đĩa thú vị
Trang chủ Giới thiệu Sinh nhật bé trai Sinh nhật bé gái Tổ chức sự kiện Biểu diễn giải trí Dịch vụ khác Trang trí tiệc cưới Tổ chức khai trương Tư vấn dịch vụ Thư viện ảnh Tin tức - sự kiện Liên hệ Chú hề sinh nhật Trang trí YEAR END PARTY công ty Trang trí tất niên cuối năm Trang trí tất niên xu hướng mới nhất Trang trí sinh nhật bé trai Hải Đăng Trang trí sinh nhật bé Khánh Vân Trang trí sinh nhật Bích Ngân Trang trí sinh nhật bé Thanh Trang Thuê ông già Noel phát quà Biểu diễn xiếc khỉ Xiếc quay đĩa
Thiết kế website Thiết kế website Thiết kế website Cách kháng tài khoản quảng cáo Mua bán Fanpage Facebook Dịch vụ SEO Tổ chức sinh nhật