Excel的VBA遍歷，文件 - 死循環

Question

我努力做到以下幾點：

1. 通過的所有文件指定一個文件夾（containinf * .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

通過看你的評論，我覺得現在的問題是，當你保存文件時，它以某種方式重新添加到收藏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 

我構建了一個由「;」分隔的字符串，然後用Split建立一個數組來避免使用索引，ReDim Preserve陳述或者測試如果文件名是空

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。
• 可以使用With塊來替代其他輔助變量（wb）。