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

问题描述

我使用以下代码来搜索文件夹中的文件名，打开该文件运行一个excel宏，保存该文件并关闭。我想把它扩展到循环遍历子文件夹，并做同样的事情。

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?

解决方案：

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

推荐答案

嗯，显然 ...

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.

已使用

WScript.Echo f.Name

代替 RunMacroAndSaveAs（）子程序如果仍然出现错误的问题在于此递归正常工作。

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

这篇关于将现有的VBS文件夹搜索应用到子文件夹？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！