Excel VBA 迭代文件 - 陷入循环

Question

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

1. 指定一个文件夹(包含 *.xlsm 文件)
2. 遍历所有文件
3. 打开每个文件，运行宏，关闭并保存文件
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

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 的引用。这对于早期绑定(bind) (New Scripting.FileSystemObject) 很有用，并且可以为您提供这些对象的代码完成。
• GetExtensionName() 对于获取文件扩展名很有用。
• 放弃匈牙利表示法，无论如何，您都不会一致地使用它。
• For Each 不需要辅助变量。
• 您可以使用 With block 来替换其他辅助变量 (wb)。