2

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

  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
4

2 回答 2

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。

主观说明：

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

通过查看您的评论，我认为问题在于当您保存文件时，它会以某种方式添加回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语句或测试文件名是否为空

于 2013-08-07T16:14:33.283 回答