遍历目录Excel文件时VBA出现1004无法移动焦点运行时错误

你的VBA代码存在几个核心逻辑错误，这是导致运行时错误和处理中断的主要原因：

1. 文件对话框使用错误 #

strPath = Application.FileDialog(msoFileDialogOpen).Show 这行完全错误：Show方法返回的是布尔值（用户点击确定返回True，取消返回False），不是选中的目录路径。你需要用文件夹选择对话框来获取目标目录，而不是文件打开对话框。

2. Dir函数调用逻辑混乱 #

你错误地将Dir的返回值赋值给fileDirectory，又用这个值作为参数再次调用Dir，完全违背了Dir函数的使用规则：

• 第一次调用Dir需要传入完整的「目录路径+通配符」来初始化遍历
• 后续调用不带参数的Dir()来获取下一个文件

3. 路径拼接未处理反斜杠 #

如果选中的目录末尾没有反斜杠，直接拼接文件名会导致路径无效（比如C:\Testfile.xls而不是C:\Test\file.xls）。

修正后的完整代码 #

Sub DirectoryFileLoop()
    Dim fileDirectory As String
    Dim fileName As String
    Dim fileToOpen As Workbook
    Dim fd As FileDialog
    
    ' 使用文件夹选择对话框获取目标目录
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .Title = "选择要处理的Excel文件所在目录"
        If .Show = -1 Then ' 用户点击确定
            fileDirectory = .SelectedItems(1)
            ' 确保目录末尾有反斜杠
            If Right(fileDirectory, 1) <> "\" Then
                fileDirectory = fileDirectory & "\"
            End If
        Else
            Exit Sub ' 用户取消操作
        End If
    End Set
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False ' 关闭保存时的提示弹窗（如兼容模式提示）
    
    ' 初始化Dir遍历，匹配所有Excel格式文件
    fileName = Dir(fileDirectory & "*.xls*")
    
    Do While Len(fileName) > 0
        Set fileToOpen = Workbooks.Open(fileDirectory & fileName)
        With fileToOpen
            .Save
            .Close
        End With
        Debug.Print fileName
        fileName = Dir ' 获取下一个文件
    Loop
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "所有文件已处理完成"
End Sub

额外注意事项 #

如果仍出现1004错误，可能是以下原因：

• 部分文件受保护（如只读、密码保护），无法直接保存
• Excel的宏安全设置阻止文件打开，可临时降低宏安全级别或添加信任目录
• 部分文件打开时会弹出额外提示（如兼容模式、链接更新），代码中Application.DisplayAlerts = False可屏蔽大部分这类提示

内容的提问来源于stack exchange，提问作者Geographos