Apply existing VBS folder search to sub folders?

Question

I am using the following code to search a folder for a file name, open the file run an excel macro, save the file, and close. I would like to extend this to loop through sub folders and do the same. There should only be one layer of sub folders but multiple folders in that layer.

dir = "C:\Users\ntunstall\Desktop\test"

Sub RunMacroAndSaveAs(file, macro)
  Set wb = app.Workbooks.Open(file)
  app.Run wb2.Name & "!" & macro
  wb.SaveAs fso.BuildPath(file.ParentFolder, fso.GetBaseName(file) & ".xlsm"), 52
  wb.Close
End Sub

Set fso = CreateObject("Scripting.FileSystemObject")
Set app = CreateObject("Excel.Application")
app.Visible       = False
app.DisplayAlerts = False
Set wb2 = app.Workbooks.Open("C:\Users\ntunstall\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB")

For Each file In fso.GetFolder(dir).Files
  If InStr(file.Name, "OPS") > 0 Then
    RunMacroAndSaveAs file, "Main"
  ElseIf InStr(file.Name, "Event") > 0 Then
    RunMacroAndSaveAs file, "Events"
  End If
Next
wScript.Quit
app.Quit

How can I modify this code to search sub folders?

Solution:

dir = "C:\Users\ntunstall\Desktop\test"

Sub RunMacroAndSaveAs(file, macro)
  Set wb = app.Workbooks.Open(file)
  Set wb2 = app.Workbooks.Open("C:\Users\ntunstall\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB")
  app.Run wb2.Name & "!" & macro
  wb.SaveAs fso.BuildPath(file.ParentFolder, fso.GetBaseName(file) & ".xlsm"), 52
  wb.Close
End Sub

Set fso = CreateObject("Scripting.FileSystemObject")
Set app = CreateObject("Excel.Application")
app.Visible = False

Dim path: path = "C:\Users\ntunstall\Desktop\test"
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
'Call this to trigger the recursion.
Call TraverseFolders(fso.GetFolder(path))

Sub TraverseFolders(fldr)
  Dim f, sf
  ' do stuff with the files in fldr here, or ...
  For Each f In fldr.Files
    If InStr(f.Name, "OPS") > 0 Then
      Call RunMacroAndSaveAs(f, "Main")
    ElseIf InStr(f.Name, "Event") > 0 Then
      Call RunMacroAndSaveAs(f, "Events")
    End If
  Next
  For Each sf In fldr.SubFolders
    Call TraverseFolders(sf)  '<- recurse here
  Next
  ' ... do stuff with the files in fldr here.
End Sub

wScript.Quit
app.Quit

Ideally, you want to [use a Recursive Function](http://stackoverflow.com/a/14965606/692942) to do this. — user692942, Dec 16 '16 at 15:04
Possible duplicate of [Recursively access subfolder files inside a folder](http://stackoverflow.com/questions/14950475/recursively-access-subfolder-files-inside-a-folder) — user692942, Dec 16 '16 at 15:04
Thank you for the response. I had viewed that questions before posting mine and, honestly, I have no idea how to implement that. I am not a programmer; just try to do some small things to make my life easier. I have, unfortunately, exhausted my knowledge(I had to ask a question just to get the code above...). — Nathan, Dec 16 '16 at 15:13

score 1 · Accepted Answer · edited May 23 '17 at 12:08

Well, apparently I'm not helpful...

Dim path: path = "C:\Users\ntunstall\Desktop\test"
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
'Call this to trigger the recursion.
Call TraverseFolders(fso.GetFolder(path))

Sub TraverseFolders(fldr)
  Dim f, sf
  ' do stuff with the files in fldr here, or ...
  For Each f In fldr.Files
    If InStr(f.Name, "OPS") > 0 Then
      Call RunMacroAndSaveAs(f, "Main")
    ElseIf InStr(f.Name, "Event") > 0 Then
      Call RunMacroAndSaveAs(f, "Events")
    End If
  Next
  For Each sf In fldr.SubFolders
    Call TraverseFolders(sf)  '<- recurse here
  Next

  ' ... do stuff with the files in fldr here.
End Sub

Taken from the method by @ansgar-wiechers - A: Recursively access subfolder files inside a folder which I already flagged as a duplicate.

Have tested this using

WScript.Echo f.Name

in place of the RunMacroAndSaveAs() Sub Procedure if it is still erroring the issue lies there as this recursion works fine.

I appreciate the fact that beginners are helped at Stackoverflow — Lajos Arpad, Dec 16 '16 at 21:25

score -1 · Answer 2 · edited May 23 '17 at 11:53

Steps towards the solution:

Create the following method:

Sub IterateFolder(dir, fso)
  For Each file In fso.GetFolder(dir).Files
    If InStr(file.Name, "OPS") > 0 Then
      RunMacroAndSaveAs file, "Main"
    ElseIf InStr(file.Name, "Event") > 0 Then
      RunMacroAndSaveAs file, "Events"
    End If
  Next
End Sub`

and call it like this: IterateFolder "C:\Users\ntunstall\Desktop\test", fso

This will still do this for the first level, but do this as a first step and understand it.

Understand fso.SubFolders

Apply the new knowledge:

Sub IterateFolder(dir, fso)
  For Each file In fso.GetFolder(dir).Files
    If InStr(file.Name, "OPS") > 0 Then
      RunMacroAndSaveAs file, "Main"
    ElseIf InStr(file.Name, "Event") > 0 Then
      RunMacroAndSaveAs file, "Events"
    End If
  Next
  For Each sf In fso.SubFolders
    IterateFolder sf, fso
  Next
End Sub

I do not work with VBScript, therefore I am not 100% sure if I'm right. If you have any problems with the solution, please ask.

EDIT:

As pointed out in the commenting section, fso is a variable which was out of scope in the Sub. I have edited my answer to make sure it is passed.

EDIT2:

Let's hope this is the coup de grace. I was mistaken in the way subfolders were iterated. Change this chunk:

For Each sf In fso.SubFolders
  IterateFolder sf, fso
Next

to this:

For Each sf In fso.GetFolder(dir).SubFolders
  IterateFolder sf, fso
Next

EDIT3:

We need to check SubFolders against null. According to this source, we should change this:

For Each sf In fso.GetFolder(dir).SubFolders
  IterateFolder sf, fso
Next

to this:

If Not IsNull(fso.GetFolder(dir).SubFolders) Then
  For Each sf In fso.GetFolder(dir).SubFolders
    IterateFolder sf, fso
  Next
End If

Comments are not for extended discussion; this conversation has been [moved to chat](http://chat.stackoverflow.com/rooms/130832/discussion-on-answer-by-lajos-arpad-apply-existing-vbs-folder-search-to-sub-fold). — Bhargav Rao, Dec 17 '16 at 09:14

Apply existing VBS folder search to sub folders?

2 Answers2

Linked