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
-
Open your VBA editor:
- In Excel (or other Office applications), press
Alt + F11
to open the Visual Basic for Applications (VBA) editor.
- In Excel (or other Office applications), press
-
Open the References window:
- In the VBA editor, go to the menu at the top and click on
Tools
, then selectReferences...
.
- In the VBA editor, go to the menu at the top and click on
-
Find the ‘Microsoft Scripting Runtime’ reference:
- In the
References
window, scroll down until you find Microsoft Scripting Runtime. The library is associated with theScripting.FileSystemObject
and provides file system access. - The full name is typically Microsoft Scripting Runtime.
- In the
-
Enable the reference:
- Check the box next to Microsoft Scripting Runtime to enable it.
-
Click OK:
- Once selected, click
OK
to add the reference to your project.
- Once selected, click
-
Verify:
- You should now be able to use the
Scripting.FileSystemObject
and related objects likeFolder
andFile
without any issues.
- You should now be able to use the
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