Excel VBA 遍历文件 - 陷入循环

Excel VBA Iterating Through Files - Stuck in a Loop

提问by j0nr

I am trying to do the following:

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

1. specify a folder (containinf *.xlsm files)
2. Iterate through all the files
3. open each file, run a macro, close and save the file
4. Move onto next file until all have been done.

1. 指定文件夹（包含 *.xlsm 文件）
2. 遍历所有文件
3. 打开每个文件，运行宏，关闭并保存文件
4. 移至下一个文件，直到完成所有操作。

The code below works, BUT the loop never ends... its as if every time I save the file that's just been worked on, it appears as a new item in the list of files to go through.

下面的代码有效，但循环永远不会结束......就好像每次我保存刚刚处理过的文件时，它都显示为要浏览的文件列表中的一个新项目。

What am I doing wrong?

我究竟做错了什么？

Thanks.

谢谢。

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

采纳答案by kb_sou

By looking at your comment, I think that the problem is that when you save the file it is somehow added back to the FSO.GetFolder(path).Filescollection Iteration. A way to work around this is to build an array with the file names and then execute your loop. The relevant code is below:

通过查看您的评论，我认为问题在于当您保存文件时，它会以某种方式添加回FSO.GetFolder(path).Files集合迭代。解决此问题的一种方法是使用文件名构建一个数组，然后执行循环。相关代码如下：

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

I built a string separated by ";" and then used Splitto build an array to avoid using indexes, ReDim Preservestatements or to test if the filename is empty

我构建了一个由“;”分隔的字符串 然后用于Split构建数组以避免使用索引、ReDim Preserve语句或测试文件名是否为空

回答by Tomalak

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

Your For Eachloop can by definition not run forever, the error must be some place else, presumably in whatever doMacrodoes.

For Each根据定义，您的循环不能永远运行，错误必须在其他地方，大概是在任何地方doMacro。

Subjective notes:

主观笔记：

• Include a reference to scrrun.dllin your VBA project. This is useful for early binding (New Scripting.FileSystemObject) and it gives you code completion for those objects.
• GetExtensionName()is useful to get a file extension.
• Drop the Hungarian notation, you are not using it consistently anyway.
• You don't need a helper variable for For Each.
• You can use a Withblock to substitute the other helper variable (wb).

• scrrun.dll在 VBA 项目中包含对 的引用。这对于早期绑定 ( New Scripting.FileSystemObject)很有用，它为您提供这些对象的代码完成。
• GetExtensionName()获取文件扩展名很有用。
• 放弃匈牙利符号，无论如何你都不会一直使用它。
• 您不需要辅助变量For Each。
• 您可以使用With块来替换其他辅助变量 ( wb)。