Question

我使用以下代码在文件夹中搜索文件名，打开文件运行excel宏，保存文件，然后关闭。我想扩展它以循环子文件夹并执行相同的操作。应该只有一层子文件夹，但该层中只有多个文件夹。

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

如何修改此代码以搜索子文件夹？

解决方案：

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

嗯，显然是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

取自@ansgar-wiechers - A: Recursively access subfolder files inside a folder的方法，我已将其标记为重复。

使用

进行了测试

WScript.Echo f.Name

代替RunMacroAndSaveAs()子过程，如果它仍然出错那么问题就在那里，因为这个递归工作正常。

Answer 2

解决方案的步骤：

创建以下方法：

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

这仍然会在第一级执行此操作，但这是第一步并理解它。

了解fso.SubFolders

应用新知识：

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％确定我是否正确。如果您对解决方案有任何疑问，请询问。

编辑：

正如评论部分所指出的，fso是一个超出Sub范围的变量。我已经编辑了我的答案以确保它已通过。

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。根据这个source，我们应该改变这个：

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

将现有的VBS文件夹搜索应用于子文件夹？

2 个答案: