替换Excel文件模块时遇run-time error '1004'文档未保存错误求解

问题背景 #

之前正常运行的批量更新Excel文件VBA模块的代码，现在在Microsoft 365 MSO（Version 2209 Build 16.0.15629.20200）64位版本下执行时，弹出**run-time error '1004'「Document not saved」**错误，推测是Excel自动更新引发的兼容性或权限问题。

常见错误原因 #

这个1004保存错误一般和以下几点有关：

• Excel宏安全策略更新：365的安全设置可能限制了对VBProject对象模型的访问
• 文件状态异常：目标文件被其他进程占用、处于只读状态，或存储路径权限不足
• 模块操作逻辑漏洞：删除模块后直接导入新模块，可能导致VBProject处于不稳定状态
• 64位环境适配：代码中部分变量或方法未适配64位Excel的要求

修复后的代码及说明 #

下面是针对问题优化后的代码，解决了原代码中的容错、权限及兼容性问题：

Option Explicit

Sub Update_VBA_Module_Pricing_Tool()
    ' 临时关闭Excel干扰设置
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim wbUpdate As Workbook
    Dim ModuleFile As String
    Dim wsActive As Worksheet
    Dim i As Long, j As Long
    Dim vbp As VBIDE.VBProject
    Dim modulename As String
    Dim temp As VBIDE.VBComponent
    
    Set wsActive = ThisWorkbook.Sheets("Pricing")
    
    ' 遍历A列的目标文件路径
    i = 2
    While wsActive.Range("A" & i).Value <> ""
        If UCase(wsActive.Range("C" & i).Value) = "Y" Then
            Application.StatusBar = "正在更新 " & wsActive.Range("B" & i).Value & " ..."
            
            ' 检查文件是否存在
            If Not IsFile(wsActive.Range("A" & i).Value) Then
                MsgBox wsActive.Range("B" & i).Value & " 文件不存在..."
                GoTo proceed_to_next
            End If
        
            ' 以读写模式打开文件，避免只读限制
            Set wbUpdate = Workbooks.Open( _
                Filename:=wsActive.Range("A" & i).Value, _
                ReadOnly:=False, _
                UpdateLinks:=xlUpdateLinksNever)
            
            ' 捕获VBProject访问权限错误
            On Error Resume Next
            Set vbp = wbUpdate.VBProject
            If Err.Number <> 0 Then
                MsgBox "无法访问" & wbUpdate.Name & "的VBA项目，请检查宏安全设置", vbCritical
                wbUpdate.Close SaveChanges:=False
                Err.Clear
                GoTo proceed_to_next
            End If
            On Error GoTo 0
            
            ' 遍历H列的模块文件路径
            j = 2
            While wsActive.Range("H" & j).Value <> ""
                If UCase(wsActive.Range("J" & j).Value) = "Y" Then
                    ModuleFile = wsActive.Range("H" & j).Value
                    modulename = wsActive.Range("I" & j).Value
            
                    ' 先检查模块是否存在，避免删除不存在的模块报错
                    On Error Resume Next
                    Set temp = vbp.VBComponents(modulename)
                    If Err.Number = 0 Then
                        vbp.VBComponents.Remove temp
                    End If
                    Err.Clear
                    On Error GoTo 0
                    
                    ' 导入新模块并重命名，捕获导入错误
                    On Error Resume Next
                    Set temp = vbp.VBComponents.Import(ModuleFile)
                    If Err.Number <> 0 Then
                        MsgBox "导入模块失败：" & ModuleFile & vbCrLf & "错误信息：" & Err.Description
                        Err.Clear
                        GoTo next_module
                    End If
                    temp.Name = modulename
                    On Error GoTo 0
                End If
next_module:
                j = j + 1
            Wend
    
            ' 保存文件，失败时尝试强制覆盖保存
            On Error Resume Next
            wbUpdate.Save
            If Err.Number <> 0 Then
                MsgBox "保存文件失败：" & wbUpdate.Name & vbCrLf & "错误信息：" & Err.Description
                Err.Clear
                wbUpdate.SaveAs Filename:=wbUpdate.FullName, FileFormat:=wbUpdate.FileFormat
            End If
            On Error GoTo 0
            
            wbUpdate.Close SaveChanges:=False
            Application.StatusBar = "完成更新 " & wsActive.Range("B" & i).Value & " ..."
        End If

proceed_to_next:
        i = i + 1
    Wend

apps_exit:
    ' 恢复Excel默认设置
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.StatusBar = False
    MsgBox "全部完成！"
End Sub

' 检查文件是否存在的辅助函数
Function IsFile(ByVal strPath As String) As Boolean
    On Error Resume Next
    IsFile = (Dir(strPath) <> "")
    On Error GoTo 0
End Function

关键优化点 #

1. 变量规范：添加Option Explicit强制变量声明，用Long替代Integer适配大行数场景
2. 权限处理：增加VBProject访问权限的错误捕获，提示用户检查宏安全设置（需在Excel选项-信任中心-宏设置中勾选"信任对VBA项目对象模型的访问"）
3. 容错逻辑：删除模块前先验证存在性，导入模块时捕获错误并提示；保存失败时尝试用SaveAs覆盖原文件
4. 状态恢复：代码结束时恢复所有Excel默认设置，避免影响后续操作

额外注意事项 #

• 确保目标Excel文件未被其他程序占用，且存储路径有读写权限
• 若目标文件在网络共享文件夹，需保证网络连接稳定，且文件未被锁定
• 运行代码前需确保已启用"信任对VBA项目对象模型的访问"权限

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