将现有的VBS文件夹search应用到子文件夹？

我正在使用下面的代码search一个文件夹的文件名，打开文件运行一个Excelmacros，保存文件，并closures。 我想扩大这个循环通过子文件夹，并做同样的事情。 应该只有一层子文件夹，但该层中有多个文件夹。

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 

我怎样才能修改这个代码来search子文件夹？

解：

 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 

Answer 1

那么，显然我没有帮助 …

 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 

从@ ansgar-wiechers的方法采取 – 答：recursion访问子文件夹内我已经标记为一个副本的文件夹 。

已经testing过这个使用

 WScript.Echo f.Name 

代替RunMacroAndSaveAs()子程序，如果它仍然错误的问题在于，因为这个recursion工作正常。

Answer 2

解决scheme的步骤：

1. 创build以下方法：

    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` 

并像这样调用它： IterateFolder "C:\Users\ntunstall\Desktop\test", fso

这仍然会做到这一点，但这是第一步，了解它。

2. 了解fso.SubFolders

3. 应用新的知识：

    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 

我不使用VBScript，因此我不能100％确定我是否正确。 如果您对解决scheme有任何疑问，请询问。

编辑：

正如评论部分所指出的那样， fso是一个超出了范围的variables。 我编辑了我的答案，以确保它通过。

EDIT2：

希望这是政变。 我错误地在子文件夹迭代的方式。 改变这个块：

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

对此：

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

EDIT3：

我们需要检查SubFolders对null。 根据这个来源 ，我们应该改变这个：

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

对此：

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