使用DocumentBeforeSave事件同时保存DOCX与HTM触发无限循环的技术问询

问题根源 #

你的代码出现无限循环的核心原因是：在SalvaActiveDocumentDocxAndHTM过程中调用了.Save和.SaveAs2，这两个操作都会触发DocumentBeforeSave事件，而该事件又会再次调用保存逻辑，直接形成死循环。另外代码还存在两个没必要的操作：关闭原文档再重新打开完全多余，而且没处理窗口关闭按钮触发的保存/关闭逻辑。

修复方案 #

解决循环的关键是在执行保存操作前临时禁用Word的事件触发，完成所有保存后再恢复。同时优化操作逻辑，补充关闭按钮的拦截处理。

步骤1：修改类模块EventClassModule #

添加关闭事件拦截，用布尔变量做双重保险避免递归：

Public WithEvents appWord As Word.Application
' 标记是否正在执行保存，防止事件重复触发
Private isSaving As Boolean

Private Sub appWord_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
    If isSaving Then Exit Sub
    
    ' 只处理已存过的文档（有路径）
    If Len(Doc.Path) > 0 Then
        Cancel = True ' 取消用户的默认保存操作
        isSaving = True
        
        ' 执行自定义保存逻辑
        SaveDocxAndHtm Doc
        
        isSaving = False
    End If
End Sub

Private Sub appWord_DocumentBeforeClose(ByVal Doc As Document, Cancel As Boolean)
    ' 如果文档有未保存修改，先执行自定义保存再关闭
    If Doc.Saved = False And Len(Doc.Path) > 0 Then
        Cancel = True
        isSaving = True
        
        SaveDocxAndHtm Doc
        Doc.Saved = True ' 标记为已保存，避免再次弹出提示
        Doc.Close
        
        isSaving = False
    End If
End Sub

步骤2：修改标准模块的保存逻辑 #

移除冗余的文档切换操作，添加事件禁用逻辑：

Public Sub SaveDocxAndHtm(ByVal targetDoc As Word.Document)
    Dim filePath As String, fileNameWithoutExt As String
    Dim originalScreenUpdating As Boolean
    Dim originalViewType As WdViewType
    
    ' 记录原视图和屏幕刷新状态
    originalViewType = Application.ActiveWindow.View.Type
    originalScreenUpdating = Application.ScreenUpdating
    
    ' 临时关闭屏幕刷新和事件触发（核心解决循环）
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    With targetDoc
        ' 保存原DOCX格式
        .Save
        
        ' 生成不带扩展名的文件名
        filePath = .Path & Application.PathSeparator
        fileNameWithoutExt = Left(.Name, InStrRev(.Name, ".") - 1)
        
        ' 另存为HTM格式
        .SaveAs2 _
            FileName:=filePath & fileNameWithoutExt & ".htm", _
            FileFormat:=wdFormatHTML, _
            AddToRecentFiles:=False
            
        ' 恢复原视图
        Application.ActiveWindow.View.Type = originalViewType
    End With
    
    ' 恢复屏幕刷新和事件
    Application.ScreenUpdating = originalScreenUpdating
    Application.EnableEvents = True
End Sub

步骤3：初始化事件监听 #

在标准模块加初始化代码，或者放到ThisDocument的打开事件里自动启动：

Public wordEvents As EventClassModule

Sub InitializeEvents()
    Set wordEvents = New EventClassModule
    Set wordEvents.appWord = Application
End Sub

如果要自动初始化，打开ThisDocument模块添加：

Private Sub Document_Open()
    InitializeEvents
End Sub

关键说明 #

• Application.EnableEvents = False：这是解决无限循环的核心，执行保存时临时关闭所有Word事件，避免.Save和.SaveAs2再次触发保存事件
• isSaving变量：作为双重保险，防止特殊情况下事件被意外触发
• 去掉关闭再打开文档的操作：直接在原文档上处理即可，不用切换文档，体验更流畅
• DocumentBeforeClose事件：专门拦截窗口右上角的关闭按钮，确保关闭前完成自定义保存

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