Excel VBA迭代文件 – 陷入循环

我正在尝试执行以下操作：

1. 指定一个文件夹（containsinf * .xlsm文件）
2. 遍历所有的文件
3. 打开每个文件，运行macros，closures并保存文件
4. 移到下一个文件，直到完成所有的事情。

下面的代码工作，但循环永远不会结束…它就好像每次我保存刚刚工作的文件，它会出现在文件列表中的新项目。

我究竟做错了什么？

谢谢。

Sub runMe() Dim objFSO As Object Dim objFolder As Object Dim objFile As Object Dim MyPath As String Dim wb As Workbook Dim myDir As String With Application .ScreenUpdating = False .DisplayAlerts = False .EnableEvents = False End With myDir = "\templates" Debug.Print ActiveWorkbook.Path MyPath = ActiveWorkbook.Path & myDir Set objFSO = CreateObject("Scripting.FileSystemObject") 'Get the folder object associated with the directory Set objFolder = objFSO.GetFolder(MyPath) 'Loop through the Files For Each objFile In objFolder.Files If InStr(objFile.Name, "~") = 0 And InStr(objFile.Name, ".xlsm") <> 0 Then Set wb = Workbooks.Open(objFile, 3) Application.Run "'" & wb.Name & "'!doMacro" wb.Close SaveChanges:=True ' Gets stuck in this loop ' WHY DOES IT KEEP LOOPING? End If Next With Application .ScreenUpdating = True .DisplayAlerts = True .EnableEvents = True End With End Sub 

Answer 1

通过查看你的评论，我认为问题是，当你保存文件，它不知何故加回到FSO.GetFolder(path).Files集合迭代。 解决这个问题的方法是用文件名build立一个数组然后执行你的循环。 相关代码如下：

 Dim aux As String, Paths as Variant, Path as Variant For Each File In FSO.GetFolder(path).Files If Not File.Name Like "~*" And File.Name Like "*.xlsm" Then aux = aux & File.Path & ";" End If Next File If Len(aux) = 0 Then Exit Sub 'No file matches the criteria Paths = Split(Left(aux, Len(aux) -1), ";") 'Builds an array with the filenames For Each Path In Paths With Workbooks.Open(Path, 3) Application.Run "'" & .Name & "'!doMacro" .Close SaveChanges:=True End With Next Path 

我build立了一个由“;”分隔的string 然后使用Split构build数组以避免使用索引， ReDim Preserve语句或testing文件名是否为空

Answer 2

 Sub runMe() Dim FSO As New Scripting.FileSystemObject Dim File As Scripting.File Dim path As String With Application .ScreenUpdating = False .DisplayAlerts = False .EnableEvents = False End With path = ActiveWorkbook.Path & "\templates" For Each File In FSO.GetFolder(path).Files If InStr(File.Name, "~") = 0 _ And LCase(FSO.GetExtensionName(File.Name)) = "xlsm" _ Then With Workbooks.Open(File.Path, 3) Application.Run "'" & .Name & "'!doMacro" .Close SaveChanges:=True En With End If Next With Application .ScreenUpdating = True .DisplayAlerts = True .EnableEvents = True End With End Sub 

你的For Each循环可以按照定义不能永远运行，这个错误肯定是其他地方的，大概是在doMacro 。

主观注意事项：

• 在您的VBA项目中包含对scrrun.dll的引用。 这对于早期绑定（ New Scripting.FileSystemObject ）非常有用，它为这些对象提供了代码完成。
• GetExtensionName()对获取文件扩展名非常有用。
• 放下匈牙利符号，反正你并没有使用它。
• For Each不需要辅助variables。
• 您可以使用With代替其他帮助variables（ wb ）。