Option Explicit
Sub Clean_Tally_Data(pwsWorkbook As Workbook)
With pwsWorkbook
End With
End Sub
' ----------------------------------------------------------------
' Procedure Name: ProcessFilesInSubFolders
' Purpose: Process files in sub folders found in a root folder.
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 6/10/2023
' ----------------------------------------------------------------
Sub ProcessFilesInSubFolders()
Dim wbCurrent As Workbook
' Name of of sub folder found.
Dim sSubFolderFound As String
' Path and file name for a file found in a sub folder.
Dim sPathAndFileName As String
' The root or starting folder to search within.
Dim sPathRootFolder As String
' Array holding names of sub folders found.
Dim asSubFoldersFound() As String
' Array holding names of files found in a sub folder.
Dim asFilesFound() As String
' Count and index used to iterate through sub folders found.
Dim iSubFoldersFoundCount As Long
Dim iSubFolder As Long
' Count and index used to iterate through files found in a sub folder.
Dim iFilesFoundCount As Long
Dim iFileFound As Long
' Enable user to select a folder.
sPathRootFolder = GetFolderFromUser() & "\"
' Tell user if there are no folders in the specified root folder.
If Not FolderExists(sPathRootFolder) _
Then
MsgBox "The root folder does not exist." & Chr(10) & sPathRootFolder, vbInformation
Exit Sub
End If
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
' Call function that loads sub folder names into the asFoldersFound array.
Call GetFoldersInRoot(sPathRootFolder, asSubFoldersFound())
' Get count of sub folders found.
iSubFoldersFoundCount = 0
On Error Resume Next
iSubFoldersFoundCount = UBound(asSubFoldersFound())
On Error GoTo 0
' Tell user if there are no files in the specified root folder.
If iSubFoldersFoundCount = 0 _
Then
MsgBox "No sub folders found in folder" & Chr(10) & sPathRootFolder & ".", vbInformation
Exit Sub
End If
' Iterate through all sub folders found to process files.
For iSubFolder = 1 To iSubFoldersFoundCount
' Name of sub folder (not path)
sSubFolderFound = asSubFoldersFound(iSubFolder)
' Call function that loads the names of files in the sub folder being processed.
' Only select Excel files
Call GetFilesInFolder(sPathRootFolder & sSubFolderFound, asFilesFound(), "*xls*")
' Count of files found in the sub folder.
iFilesFoundCount = 0
On Error Resume Next
iFilesFoundCount = UBound(asFilesFound())
On Error GoTo 0
If iFilesFoundCount <> 0 _
Then
' Iterate through all files found in the sub folder.
For iFileFound = 1 To iFilesFoundCount
' Get full path and filename.
sPathAndFileName = sPathRootFolder & sSubFolderFound & "\" & asFilesFound(iFileFound)
' Open workbook. Point wbCurrent object to the opened workbook.
Set wbCurrent = Workbooks.Open(sPathAndFileName)
' Call sub that modifies the file.
Call Clean_Tally_Data(wbCurrent)
' Close the current workbook.
wbCurrent.Close
Next iFileFound
End If
Next iSubFolder
End Sub
' ----------------------------------------------------------------
' Procedure Name: GetFoldersInRoot
' Purpose: Load array parameter with name(s) of folders in the specified "root" folder.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psPathRootFolder (String): Path to and name of "root" folder to look within.
' Parameter pasFilesFound (String): Array parameter filled with folder names found in the "root" folder.
' Return Type: String)
' Author: Jim
' Date: 6/10/2023
' ----------------------------------------------------------------
Function GetFoldersInRoot( _
psPathRootFolder As String, _
pasFoldersFound() As String)
' Name of a folder found.
Dim sFolderName As String
' Used to keep track of how many folders are found in the root folder.
Dim iFolderNum As Long
' Get name of first sub folder in the root folder.
sFolderName = Dir(psPathRootFolder & "\*", vbDirectory)
' Process sub folders 2 through n where n is number of sub folders - 1
Do While sFolderName <> ""
If GetAttr(psPathRootFolder & "\" & sFolderName) And vbDirectory _
Then
' Screen out results one dot and two dots which Dir function returns.
If Not sFolderName = "." And Not sFolderName = ".." _
Then
' Increment count of folders are found.
iFolderNum = iFolderNum + 1
' Resize the array parameter to accommodate the current sub folder found.
ReDim Preserve pasFoldersFound(iFolderNum)
' Put the naemof the folder into the array.
pasFoldersFound(iFolderNum) = sFolderName
End If
End If
' Get name of next folder, if any.
sFolderName = Dir
Loop
End Function
' ----------------------------------------------------------------
' Procedure Name: GetFilesInFolder
' Purpose: Load array parameter with name(s) of files in the specified folder.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psFolder (String): Path to and name of folder to process.
' Parameter pasFilesFound (String): Array parameter filled with file names found in the specified folder.
' Return Type: String)
' Author: Jim
' Date: 6/10/2023
' ----------------------------------------------------------------
Function GetFilesInFolder(psFolder As String, pasFilesFound() As String, Optional psScreen As String = "*")
' Name of the file found.
Dim sFileFound As String
' Count of files found in the specified folder. Used to index names as they are found.
Dim iFilesFound As Long
' Get name of first file in the folder specified, if any.
sFileFound = Dir(psFolder & "\" & psScreen)
' Iterate until no more files are found.
Do While sFileFound <> ""
' Increment count of files found.
iFilesFound = iFilesFound + 1
' Resize the pasFilesFound array parameter to accommodate the name of the file found.
ReDim Preserve pasFilesFound(iFilesFound)
' Putname of file found into the array parameter.
pasFilesFound(iFilesFound) = sFileFound
' Get name of next file in the folder specified, if any.
sFileFound = Dir
Loop
End Function
'
' ----------------------------------------------------------------
' Procedure Name: FolderExists
' Purpose: Determine if a path => folder exists.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psPathAndFolder (String): Path and folder name.
' Return Type: Boolean
' Author: Jim
' Date: 6/11/2023
' ----------------------------------------------------------------
Function FolderExists(psPathAndFolder As String) As Boolean
Dim sFolderExists As String
FolderExists = False
sFolderExists = Dir(psPathAndFolder, vbDirectory)
If sFolderExists <> "" Then FolderExists = True
End Function
