VBA执行Workbooks.Open时偶发Error 400(1004)问题求助

这段VBA代码用于将外部Excel文件数据加载到现有工作表，多数场景运行正常，但偶尔会触发Error 400错误，或提示Workbooks.Open函数无法工作。

原代码 #

Sub loadData()

On Error GoTo MyHandler

Dim ActSht As Worksheet
Dim FileToOpen As Variant
Dim CurrBook As Workbook
Dim OpenBook As Workbook

Set ActSht = ActiveSheet
Set CurrBook = ThisWorkbook

FileToOpen = Application.GetOpenFilename(Title:="Neue Datei auswählen", FileFilter:="Excel Files (*xlsx*), *xlsx*")

If FileToOpen <> False Then

Application.DisplayAlerts = False

Set OpenBook = Application.Workbooks.Open(FileToOpen)

OpenBook.Sheets("Items").UsedRange.Copy
CurrBook.Sheets("New_File").Range("A1").PasteSecial XlPasteValues

OpenBook.Close False
MsgBox "Neue Datei wurde geladen"

Else
MsgBox "Keine Datei geladen"

End If

Application.DisplayAlters = True

ActSht.Activate

Exit Sub

MyHandler:
MsgBox "Fehler: " & Err.Description

End Sub

已尝试措施 #

• 移入新模块
• 调整信任中心设置
• 更换文件加载方式

解决方案 #

1. 修复代码拼写错误 #

原代码存在两处低级拼写错误，可能是偶发异常的诱因：

• PasteSecial → 修正为PasteSpecial
• Application.DisplayAlters → 修正为Application.DisplayAlerts

2. 增强文件打开的容错性 #

给Workbooks.Open添加参数，应对文件锁定、只读推荐等场景，同时增加文件存在性检查：

If Dir(FileToOpen) = "" Then
    MsgBox "所选文件不存在或路径无效"
    GoTo Cleanup
End If

Set OpenBook = Application.Workbooks.Open( _
    Filename:=FileToOpen, _
    ReadOnly:=True, _
    IgnoreReadOnlyRecommended:=True, _
    Editable:=False, _
    Notify:=False)

3. 避免依赖ActiveSheet #

直接通过工作表名称或代码名引用，消除激活状态变化带来的不确定性：

' 替换Set ActSht = ActiveSheet
Set ActSht = CurrBook.Sheets("目标工作表名称") ' 或使用代码名如Sheet1

4. 替换复制粘贴为直接赋值 #

绕过剪贴板，直接将数据赋值到目标区域，更稳定高效：

Dim sourceRange As Range
Set sourceRange = OpenBook.Sheets("Items").UsedRange
With CurrBook.Sheets("New_File").Range("A1")
    .Resize(sourceRange.Rows.Count, sourceRange.Columns.Count).Value = sourceRange.Value
End With

5. 优化错误处理 #

在错误分支中补充错误编号和出错行号，便于精准定位问题：

MyHandler:
MsgBox "错误编号: " & Err.Number & vbCrLf & _
       "错误描述: " & Err.Description & vbCrLf & _
       "出错行号: " & Erl

修正后的完整代码 #

Sub loadData()
    On Error GoTo MyHandler

    Dim ActSht As Worksheet
    Dim FileToOpen As Variant
    Dim CurrBook As Workbook
    Dim OpenBook As Workbook
    Dim sourceRange As Range

    Set CurrBook = ThisWorkbook
    ' 直接引用目标工作表，避免ActiveSheet依赖
    Set ActSht = CurrBook.Sheets("你的工作表名称")

    FileToOpen = Application.GetOpenFilename( _
        Title:="选择要加载的文件", _
        FileFilter:="Excel Files (*.xlsx), *.xlsx")

    If FileToOpen <> False Then
        ' 检查文件是否存在
        If Dir(FileToOpen) = "" Then
            MsgBox "所选文件不存在或路径无效"
            GoTo Cleanup
        End If

        Application.ScreenUpdating = False
        Application.DisplayAlerts = False

        ' 增强容错的文件打开方式
        Set OpenBook = Application.Workbooks.Open( _
            Filename:=FileToOpen, _
            ReadOnly:=True, _
            IgnoreReadOnlyRecommended:=True, _
            Editable:=False, _
            Notify:=False)

        ' 直接赋值代替复制粘贴
        Set sourceRange = OpenBook.Sheets("Items").UsedRange
        With CurrBook.Sheets("New_File").Range("A1")
            .Resize(sourceRange.Rows.Count, sourceRange.Columns.Count).Value = sourceRange.Value
        End With

        OpenBook.Close False
        MsgBox "文件加载完成"
    Else
        MsgBox "未选择任何文件"
    End If

Cleanup:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    ActSht.Activate
    Exit Sub

MyHandler:
    MsgBox "错误编号: " & Err.Number & vbCrLf & _
           "错误描述: " & Err.Description & vbCrLf & _
           "出错行号: " & Erl
    Resume Cleanup
End Sub

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