Ceate a root directory to select multiple files at once.

**B_Jarbs** · 01-07-2016, 11:45 AM

I currently am writing a code where I take multiple files at once and put some of their data into a master file. Right now my code can take a folder and read what is inside that folder and open any excel file that is in that folder. The issue is, if there is a folder within that folder it will not open that folder to check if there are more files in it. So I need to write a code that can select a root directory and let it run through all folders within the folder selected.
This is what i currently have

Option Explicit

Sub ExtrData()
Dim MyFolder As String  'Store the folder selected by the user
Dim sFile As String
Dim wk As Workbook
Dim i As Integer

Application.ScreenUpdating = False

'Display the folder picker dialog box for user selection of directory
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Please select a folder"
    .Show
    .AllowMultiSelect = False
    If .SelectedItems.Count = 0 Then
        MsgBox "You did not select a folder"
        Exit Sub
    End If
    MyFolder = .SelectedItems(1) & "\"
End With

'Dir finds the files in the selected folder,
sFile = Dir(MyFolder)

If sFile = "" Then
    MsgBox "No files matching set criteria found"
   Exit Sub
End If

 i = 2
Do While sFile <> ""
    Set wk = Workbooks.Open(MyFolder & sFile)
On Error Resume Next
    Sheets("Deckblatt,  Cover Sheet").Activate
 If Err.Number = 9 Then
        wk.Close SaveChanges:=False
        GoTo skipper
 End If

**LJMetzger** · 01-11-2016, 06:02 PM

Hi B_Jarbs,

Try the following code which is included in the attached file. The attached file is meant as a control file, from which you can open your master file and all your data files. Instead of an Interactive Folder Picker, I have the Folder Picker in a separate module, that stores the Folder Path in the Control File.

I see that you are already using 'Option Explicit' which is very important.

In an ordinary code module:

Option Explicit
Option Compare Text   'Makes the 'Like' and 'Instr' Functions CASE INSENSITIVE


Private Const sControlSheet = "Sheet1"
Private Const sBaseFolderNameCELL = "C4"
Private Const sFolderSearchStringCELL = "C6"
Private Const nDoubleLineROW = 20

Sub ClearOutputArea()
  Sheets(sControlSheet).Range("A21:Z" & Rows.Count).ClearContents
End Sub

Sub ProcessMatchingFile(sPathAndMatchingFileName)

  'Your file processing code goes here

  'Open File
  
  'Do what needs to be done
  
  'Close File

End Sub

Sub ProcessMatchingFilesInAllSubFolders()
  'This will process all Matching Files in all SubFolders

  Dim ws As Worksheet
  Dim fso As Object
  Dim objFolder As Object
  Dim objSubFolder As Object

  Dim iLevel As Long
  Dim iMatchCount As Long
  Dim iOutputRow As Long
  Dim sBaseFolder As String
  Dim sBaseFolderAndFileMaskCombination As String
  Dim sFileMask As String
  Dim sMatchingFileName As String
  Dim sPathAndMatchingFileName As String
  Dim sPathAndMatchingFolderName As String
  Dim sSearchSpec As String
  Dim sSubFolderName As String
  
  
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Initialization
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
  'Create the Worksheet Object
  Set ws = ThisWorkbook.Sheets(sControlSheet)
  
  'Clear the Output Area
  Call ClearOutputArea
  
  'Initialize the OUTPUT row to one row before the first output row
  iOutputRow = nDoubleLineROW
  
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Get the Input values and display their values
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
  'Get the Base Folder Name (without leading/trailing spaces)
  'If BLANK, use the folder that this file is in
  sBaseFolder = Trim(ws.Range(sBaseFolderNameCELL).Value)
  If Len(sBaseFolder) = 0 Then
    sBaseFolder = ThisWorkbook.Path
  End If
  
  'Make sure the path has a trailing backslash
  If Right(sBaseFolder, 1) <> "\" Then
    sBaseFolder = sBaseFolder & "\"
  End If
  
  'Get the Partial Folder Name String (without leading/trailing spaces)
  'Add a '*' (find all matches) to the end of the Search Spec if there is no '*' in the 'Partial Folder Name'
  sFileMask = Trim(ws.Range(sFolderSearchStringCELL).Value)
  If InStr(sFileMask, "*") = 0 Then
    sFileMask = sFileMask & "*"
  End If
  

  'Build the complete 'Search Specification'
  sBaseFolderAndFileMaskCombination = sBaseFolder & sFileMask
  
  'Output the Search Criteria:
  iOutputRow = iOutputRow + 1
  ws.Cells(iOutputRow, "A").Value = "Base Folder Name: " & sBaseFolder
  
  iOutputRow = iOutputRow + 1
  If Len(sFileMask) = 0 Then
    ws.Cells(iOutputRow, "A").Value = "All files will be processed."
  Else
    ws.Cells(iOutputRow, "A").Value = "Files matching the following mask will be processed: " & sFileMask
  End If
  
  iOutputRow = iOutputRow + 1
  ws.Cells(iOutputRow, "A").Value = "Complete Search Specification: " & sBaseFolderAndFileMaskCombination
  
  iOutputRow = iOutputRow + 1
  ws.Cells(iOutputRow, "A").Value = "Processing ALL matches in the Base Folder and all SubFolders."
  
  'Create a BLANK line
  iOutputRow = iOutputRow + 1

  
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Search Preliminaries
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
  'Create the File System Object
  'Create the Folder Object
  'Exit if the 'Base Folder' does not exist.
  Set fso = CreateObject("Scripting.FileSystemObject")
  On Error Resume Next
  Set objFolder = fso.GetFolder(sBaseFolder)
  If Err.Number <> 0 Then
    MsgBox "NOTHING DONE.  The 'Base Folder' does NOT exist." & vbCrLf & _
           "Base Folder Name: '" & sBaseFolder & "'"
    GoTo MYEXIT
  End If
  On Error GoTo 0


  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Find all matches in the 'Base Folder' Only
  'Dir() is used in favor of FileSystemObject to allow wildcard search
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
  'Build the Complete Folder and SubFolder Name
  sPathAndMatchingFolderName = sBaseFolder
    
  'Output a Message
  iOutputRow = iOutputRow + 1
  ws.Cells(iOutputRow, "A").Value = "-----  " & "Folder: " & sPathAndMatchingFolderName
    
  'Create the 'Search Specification' for Dir()
  'Get the First Matching File Name (if any)
  sSearchSpec = sPathAndMatchingFolderName & sFileMask
  sMatchingFileName = Dir(sSearchSpec)
    
  'Keep on Processing until the 'Matching File Name' is BLANK
  While Len(sMatchingFileName) > 0
    
    'Build the Complete Path and File Name
    sPathAndMatchingFileName = sPathAndMatchingFolderName & sMatchingFileName
      
    'Increment the Match Counter
    'Output a Message
    iMatchCount = iMatchCount + 1
    iOutputRow = iOutputRow + 1
    ws.Cells(iOutputRow, "A").Value = Format(iMatchCount, "000  ") & "Processing " & sPathAndMatchingFileName
      
    'User Specific File Processing
    Call ProcessMatchingFile(sPathAndMatchingFileName)
      
    'Get the Next File Name
    sMatchingFileName = Dir()
  Wend
    
    
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Recursively Search SubFolders
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  iLevel = 0
  Call RecursiveFolderSearch(sBaseFolder, sFileMask, sBaseFolder, iLevel, iMatchCount, iOutputRow, ws)
    
  
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Output Completion Messages
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  If iMatchCount = 0 Then
    iOutputRow = iOutputRow + 1
    ws.Cells(iOutputRow, "A").Value = "NO matching Folders were found."
  End If
  
  'Output a completion message
  iOutputRow = iOutputRow + 1
  iOutputRow = iOutputRow + 1
  ws.Cells(iOutputRow, "A").Value = "Search completed on " & Format(Now(), "ddd mmmm d, yyyy  hh:mm:ss AM/PM") & "."
  
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Termination
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
MYEXIT:
  'Clear Object Pointers
  Set fso = Nothing
  Set objFolder = Nothing
  Set ws = Nothing

End Sub


Sub RecursiveFolderSearch(sPath As String, _
                          sFileMask As String, _
                          sBaseFolder As String, _
                    ByRef iLevel As Long, _
                    ByRef iMatchCount As Long, _
                    ByRef iOutputRow As Long, _
                          ws As Worksheet)
  'This recursively searches for Folder Names
  '
  'This ignores folders in 'Level 0' (Base Folder) to allow a prior search for 'Base Folder' matches
  '
  ' 'ByRef' items are modified by this routine

  Dim fso As Object
  Dim objFolder As Object
  Dim objSubFolder As Object
  
  Dim sMatchingFileName As String
  Dim sPathAndMatchingFileName As String
  Dim sPathAndMatchingFolderName As String
  Dim sSearchSpec As String
  Dim sSubFolderName As String

  'Create the File System Object
  'Create the Folder Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set objFolder = fso.GetFolder(sPath)

  'Traverse Each SubFolder
  For Each objSubFolder In objFolder.SubFolders
    
    'Get the Next SubFolder Name
    'Build the Complete Folder and SubFolder Name
    sSubFolderName = objSubFolder.Name
    sPathAndMatchingFolderName = sPath & sSubFolderName & "\"
    
    'Increment the Output Row
    'Create an Output Message
    iOutputRow = iOutputRow + 1
    ws.Cells(iOutputRow, "A").Value = "-----  " & "Folder: " & sPathAndMatchingFolderName
      
    'Create the 'Search Specification' for Dir()
    'Get the First Matching File Name (if any)
    sSearchSpec = sPathAndMatchingFolderName & sFileMask
    sMatchingFileName = Dir(sSearchSpec)
      
    'Keep on Processing until the 'Matching File Name' is BLANK
    While Len(sMatchingFileName) > 0
      
      'Build the Complete Path and File Name
      sPathAndMatchingFileName = sPathAndMatchingFolderName & sMatchingFileName
      
      'Increment the Match Counter
      'Output a Message
      iMatchCount = iMatchCount + 1
      iOutputRow = iOutputRow + 1
      ws.Cells(iOutputRow, "A").Value = Format(iMatchCount, "000  ") & "Processing " & sPathAndMatchingFileName
      
      'User Specific File Processing
      Call ProcessMatchingFile(sPathAndMatchingFileName)
      
      'Get the Next File NAME
      sMatchingFileName = Dir()
    Wend
      
    'Drill down to the next Sub-Level
    Call RecursiveFolderSearch(sPath & objSubFolder.Name & "\", sFileMask, sBaseFolder, iLevel + 1, iMatchCount, iOutputRow, ws)
    
  Next objSubFolder
  
  
MYEXIT:

  'Clear object pointers
  Set fso = Nothing
  Set objFolder = Nothing
  
End Sub

Lewis

**B_Jarbs** · 01-12-2016, 12:03 PM

Thanks, this gave some good insight on how the directory works. With this code though, how do I copy certain cells from those open files? I was using something like this

  Range("E14").Copy
    ThisWorkbook.Sheets("Data").Range("C" & i).PasteSpecial xlPasteValues

but that was with the single folder picker. I have 2 different sheets that I am copying from for each file.
Thanks again for taking the time to look at this.

**LJMetzger** · 01-12-2016, 04:06 PM

Hi,

The attached zip file contains files:
a. ExcelForumProcessFilesInSubFolders2.xls - Updated copy of the previous file that actually processes files and puts results in a destination file.
b. ExcelForumDestinationFile.xlsx - Simulated destination file.
c. ExcelForumSourceFile1.xlsx - Simulated source file
d. ExcelForumSourceFile2.xlsx - Simulated source file with different data

The following contains code excerpts to demonstrate how the source and destination files are processed:

Option Explicit

Private Const sControlSheetNAME = "Sheet1"
Private Const sDestinationSheetNAME = "Sheet1"
Private Const sBaseFolderNameCELL = "C5"
Private Const sFolderSearchStringCELL = "C7"
Private Const sDestinationFolderandFileNameCELL = "C9"
Private Const nDoubleLineROW = 25

Sub ProcessOneSourceFile(sPathAndMatchingFileName As String, wsDestination As Worksheet)
  'Your file processing code goes in this routine
  
  Dim wbSource As Workbook
  Dim wsDeckblatt As Worksheet
  Dim wsCoverSheet As Worksheet  'Just in Case there is an English and Non-English Version
  
  Dim iDestinationSheetLastRowUsed As Long
  Dim iDestinationRow As Long
  
  Dim sSourceFileName As String
  Dim sSourceFolderName As String

  'Get the Source Folder and File Names
  sSourceFolderName = LjmExtractPath(sPathAndMatchingFileName)
  sSourceFileName = LjmExtractFullFileName(sPathAndMatchingFileName)

  'Open  the SourceFile
  Set wbSource = Workbooks.Open(FileName:=sPathAndMatchingFileName, ReadOnly:=True)
  
  'Create the Worksheet Objects
  Set wsDeckblatt = wbSource.Sheets("Deckblatt")
  Set wsCoverSheet = wbSource.Sheets("Cover Sheet")
  
  'Find the Last Row Used on the Destination Sheet (A runtime error will occur if the Sheet is Empty)
  On Error Resume Next
  iDestinationSheetLastRowUsed = wsDestination.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  If Err.Number <> 0 Then
    Err.Clear
    iDestinationSheetLastRowUsed = 1
  End If
  On Error GoTo 0
  
  'Set the Destination Row to the Last Row after the Last Row Used on the Destination Sheet
  iDestinationRow = iDestinationSheetLastRowUsed + 1
  
  
  'Copy Administrative Data to the 'Destination' Sheet
  wsDestination.Cells(iDestinationRow, "A").Value = sSourceFileName
  wsDestination.Cells(iDestinationRow, "B").Value = sSourceFolderName
  
  
  'Copy Data from Sheet 'Cover Sheet' to the 'Destination' Sheet
  wsDestination.Cells(iDestinationRow, "C").Value = wsCoverSheet.Range("F3").Value
  wsDestination.Cells(iDestinationRow, "D").Value = wsCoverSheet.Range("D14").Value
  
  
  'Copy Data from Sheet 'Deckblatt' to the 'Destination' Sheet
  wsDestination.Cells(iDestinationRow, "E").Value = wsDeckblatt.Range("D3").Value
  wsDestination.Cells(iDestinationRow, "F").Value = wsDeckblatt.Range("D7").Value
  wsDestination.Cells(iDestinationRow, "G").Value = wsDeckblatt.Range("D11").Value
  
  
  'Close Source File
  wbSource.Close SaveChanges:=False

  'Clear  Object pointers
  Set wbSource = Nothing
  Set wsDeckblatt = Nothing
  Set wsCoverSheet = Nothing
  
End Sub

Sub ProcessMatchingFilesInAllSubFolders()
  'This will process all Matching Files in all SubFolders

  Dim wbDestination As Workbook
  Dim wsControl As Worksheet
  Dim wsDestination As Worksheet
  Dim fso As Object
  Dim objFolder As Object

  Dim iLevel As Long
  Dim iMatchCount As Long
  Dim iOutputRow As Long
  Dim sBaseFolder As String
  Dim sBaseFolderAndFileMaskCombination As String
  Dim sDestinationFileName As String
  Dim sDestinationPath As String
  Dim sDestinationPathAndFileName As String
  Dim sFileMask As String
  Dim sMatchingFileName As String
  Dim sPathAndMatchingFileName As String
  Dim sPathAndMatchingFolderName As String
  Dim sSearchSpec As String
  
  
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Initialization
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
  'Code deleted
  
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Get the Input values and display their values
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
  'Code deleted - comments left behind

  'Get the Base Folder Name (without leading/trailing spaces)
  
  'Get the File Mask (without leading/trailing spaces)
  'Add a '*' (find all matches) to the end of the Search Spec if there is no '*' in the 'Partial Folder Name'
  
  'Get the Destination Path and File Name
  

  'Build the complete 'Search Specification'
  sBaseFolderAndFileMaskCombination = sBaseFolder & sFileMask
  
  
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Search Preliminaries
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
  'Create the File System Object
  'Create the Folder Object
  'Exit if the 'Base Folder' does not exist.
  Set fso = CreateObject("Scripting.FileSystemObject")
  On Error Resume Next
  Set objFolder = fso.GetFolder(sBaseFolder)
  If Err.Number <> 0 Then
    MsgBox "NOTHING DONE.  The 'Base Folder' does NOT exist." & vbCrLf & _
           "Base Folder Name: '" & sBaseFolder & "'"
    GoTo MYEXIT
  End If
  On Error GoTo 0
  
  
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Open the Destination File
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
  sDestinationPath = LjmExtractPath(sDestinationPathAndFileName)
  sDestinationFileName = LjmExtractFullFileName(sDestinationPathAndFileName)
  
  If LJMFileExists(sDestinationPathAndFileName) = False Then
    MsgBox "NOTHING DONE.  The 'Destination Folder and/or File' does NOT exist." & vbCrLf & _
           "Folder: '" & sDestinationPath & "'" & vbCrLf & _
           "File: '" & sDestinationFileName & "'"
    GoTo MYEXIT
  End If
  
  If LjmIsWorkbookOpen(sDestinationFileName) = True Then
    MsgBox "NOTHING DONE.  The 'Destination File is NOT ALLOWED to be OPEN." & vbCrLf & _
           "Try again after the Destination File is CLOSED." & vbCrLf & _
           "Name: '" & sDestinationFileName & "'"
    GoTo MYEXIT
  End If
  
  'Create the Destination Objects
  Set wbDestination = Workbooks.Open(sDestinationPathAndFileName)
  
  If LjmWorkbookAndSheetExists(sDestinationFileName, sDestinationSheetNAME) = False Then
    MsgBox "NOTHING DONE.  The 'Destination File MUST CONTAIN Sheet '" & sDestinationSheetNAME & "'." & vbCrLf & _
           "Folder: '" & sDestinationPath & "'" & vbCrLf & _
           "File: '" & sDestinationFileName & "'"
    GoTo MYEXIT
  End If
  
  Set wsDestination = wbDestination.Sheets(sDestinationSheetNAME)

  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Find all matches in the 'Base Folder' Only
  'Dir() is used in favor of FileSystemObject to allow wildcard search
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  sPathAndMatchingFolderName = sBaseFolder
    
  'Output a Message
  iOutputRow = iOutputRow + 1
  wsControl.Cells(iOutputRow, "A").Value = "-----  " & "Folder: " & sPathAndMatchingFolderName
    
  'Create the 'Search Specification' for Dir()
  'Get the First Matching File Name (if any)
  sSearchSpec = sPathAndMatchingFolderName & sFileMask
  sMatchingFileName = Dir(sSearchSpec)
    
  'Keep on Processing until the 'Matching File Name' is BLANK
  While Len(sMatchingFileName) > 0
    
    'Build the Complete Path and File Name
    sPathAndMatchingFileName = sPathAndMatchingFolderName & sMatchingFileName
      
    'Increment the Match Counter
    'Output a Message
    iMatchCount = iMatchCount + 1
    iOutputRow = iOutputRow + 1
    wsControl.Cells(iOutputRow, "A").Value = Format(iMatchCount, "000  ") & "Processing " & sPathAndMatchingFileName
      
    'User Specific File Processing
    Call ProcessOneSourceFile(sPathAndMatchingFileName, wsDestination)
      
    'Get the Next File Name
    sMatchingFileName = Dir()
  Wend
          
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Recursively Search SubFolders
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  iLevel = 0
  Call RecursiveFolderSearch(sBaseFolder, sFileMask, sBaseFolder, iLevel, iMatchCount, iOutputRow, wsControl, wsDestination)
    
  
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Output Completion Messages
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  If iMatchCount = 0 Then
    iOutputRow = iOutputRow + 1
    wsControl.Cells(iOutputRow, "A").Value = "NO matching Folders were found."
  End If
  
  'Output a completion message
  iOutputRow = iOutputRow + 1
  iOutputRow = iOutputRow + 1
  wsControl.Cells(iOutputRow, "A").Value = "Search completed on " & Format(Now(), "ddd mmmm d, yyyy  hh:mm:ss AM/PM") & "."
  
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Termination
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
  'AutoFit the Destination Sheet Columns
  wsDestination.Cells.Columns.AutoFit
  
MYEXIT:
  'Restore Screen Updating
  Application.ScreenUpdating = True
  
  'Close and save the 'Destination File' if possible
  On Error Resume Next
  wbDestination.Save
  wbDestination.Close
  On Error GoTo 0

  'Clear Object Pointers
  Set fso = Nothing
  Set objFolder = Nothing
  Set wsControl = Nothing
  Set wbDestination = Nothing
  Set wsDestination = Nothing
End Sub

Sub RecursiveFolderSearch(sPath As String, _
                          sFileMask As String, _
                          sBaseFolder As String, _
                    ByRef iLevel As Long, _
                    ByRef iMatchCount As Long, _
                    ByRef iOutputRow As Long, _
                          wsControl As Worksheet, _
                          wsDestination As Worksheet)
  'This recursively searches for Folder Names
  '
  'This ignores folders in 'Level 0' (Base Folder) to allow a prior search for 'Base Folder' matches
  '
  ' 'ByRef' items are modified by this routine

  Dim fso As Object
  Dim objFolder As Object
  Dim objSubFolder As Object
  
  Dim sMatchingFileName As String
  Dim sPathAndMatchingFileName As String
  Dim sPathAndMatchingFolderName As String
  Dim sSearchSpec As String
  Dim sSubFolderName As String

  'Create the File System Object
  'Create the Folder Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set objFolder = fso.GetFolder(sPath)

  'Traverse Each SubFolder
  For Each objSubFolder In objFolder.SubFolders
    
    'Get the Next SubFolder Name
    'Build the Complete Folder and SubFolder Name
    sSubFolderName = objSubFolder.Name
    sPathAndMatchingFolderName = sPath & sSubFolderName & "\"
    
      
    'Increment the Output Row
    'Create an Output Message
    iOutputRow = iOutputRow + 1
    wsControl.Cells(iOutputRow, "A").Value = "-----  " & "Folder: " & sPathAndMatchingFolderName
      
    'Create the 'Search Specification' for Dir()
    'Get the First Matching File Name (if any)
    sSearchSpec = sPathAndMatchingFolderName & sFileMask
    sMatchingFileName = Dir(sSearchSpec)
      
    'Keep on Processing until the 'Matching File Name' is BLANK
    While Len(sMatchingFileName) > 0
      
      'Build the Complete Path and File Name
      sPathAndMatchingFileName = sPathAndMatchingFolderName & sMatchingFileName
      
      'Increment the Match Counter
      'Output a Message
      iMatchCount = iMatchCount + 1
      iOutputRow = iOutputRow + 1
      wsControl.Cells(iOutputRow, "A").Value = Format(iMatchCount, "000  ") & "Processing " & sPathAndMatchingFileName
      
      'User Specific File Processing
      Call ProcessOneSourceFile(sPathAndMatchingFileName, wsDestination)
      
      'Get the Next File NAME
      sMatchingFileName = Dir()
    Wend
      
    'Drill down to the next Sub-Level
    Call RecursiveFolderSearch(sPath & objSubFolder.Name & "\", sFileMask, sBaseFolder, iLevel + 1, iMatchCount, iOutputRow, wsControl, wsDestination)
    
  Next objSubFolder
  
  
MYEXIT:

  'Clear object pointers
  Set fso = Nothing
  Set objFolder = Nothing
  
End Sub