title: Traverse subdirectories and open files in those directories
body: <p>I'm trying to write VBA code that does the following:</p>
  <ul>
  <li>Finds all *.xlsx and *.xlsm files in specified path and subdirectories</li>
  <li>Opens each one read-only</li>
  <li>Copies the contents to the current spreadsheet, then closes file</li>
  <li>Loops through all files</li>
  </ul>
  <p>The closest I've been able to get is derived from <a href="https://stackoverflow.com/questions/22645347/loop-through-all-subfolders-using-vba">Loop Through All Subfolders Using VBA</a>, where FolderPath is &quot;C:\Path\To\Folder&quot;:</p>
  <pre class="lang-vb prettyprint-override"><code>Dim fso, oFolder, oSubfolder, oFile, queue As Collection
  Set fso = CreateObject(&quot;Scripting.FileSystemObject&quot;)
  Set queue = New Collection
  queue.Add fso.GetFolder(FolderPath)
  Do While queue.Count &gt; 0
      Set oFolder = queue(1)
      queue.Remove 1
      For Each oSubfolder In oFolder.SubFolders
          queue.Add oSubfolder
      Next oSubfolder
      For Each oFile In oFolder.Files
          Length = InStrRev(oFile, &quot;\&quot;)
          oFileWB = Right(oFile, Len(oFile) - Length)
          'Open the given .xls* file read-only and suppress link update prompt
          Workbooks.Open FileName:=oFile, ReadOnly:=True, UpdateLinks:=False
          'Get current first empty row of database as first target row
          ftr = ThisWorkbook.Worksheets(&quot;Database&quot;).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
          'Copy range from target sheet, from hardcoded cell A7 to AE in the bottom-most occupied row
          Workbooks(oFileWB).Sheets(&quot;Target Sheet&quot;).Range(&quot;A7:AE&quot; &amp; Workbooks(oFileWB).Sheets(&quot;Target Sheet&quot;).Cells(Rows.Count, 1).End(xlUp).Row).Copy
          'Paste above range into the first empty cell of the database
          ThisWorkbook.Worksheets(&quot;Database&quot;).Range(ThisWorkbook.Worksheets(&quot;Database&quot;).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Address).PasteSpecial xlPasteValues
          'Get last row of current database after copying data
          ltr = ThisWorkbook.Worksheets(&quot;Database&quot;).Cells(Rows.Count, 1).End(xlUp).Row
          'Copy date and filepath of sheet into all rows
          ThisWorkbook.Worksheets(&quot;Database&quot;).Range(&quot;AF&quot; &amp; ftr &amp; &quot;:AF&quot; &amp; ltr).Value = Now()
          ThisWorkbook.Worksheets(&quot;Database&quot;).Range(&quot;AG&quot; &amp; ftr &amp; &quot;:AG&quot; &amp; ltr).Value = oFile
          'Close current file and suppress save changes prompt
          Workbooks(oFileWB).Close savechanges:=False
      Next oFile
  Loop
  </code></pre>
  <p>This works when nothing is open in those directories.</p>
  <p>When one of the files is locked, it starts scanning files in &quot;C:&quot; instead of &quot;C:\Path\To\Folder&quot;. This gives a permission error because it tries to open hiberfile.sys. This is a critical problem because this script (a) needs to act in an entirely read-only manner, and (b)  files in these directories may be locked at any given time.</p>
  <p>Also as a lesser issue - how can I restrict it to opening *.xlsx and *.xlsm files?</p>