Outlook邮件取消时报表发送异常问题及错误处理代码请求

嘿，我碰到过好几个类似的Access+Outlook邮件发送的问题，你这个情况核心是取消发送时触发的未处理错误导致资源没被正确清理，旧的筛选上下文或者锁定状态残留了。给你改一下代码，重点在错误处理块里加资源清理的逻辑，确保不管成功还是失败，都把该关的关、该清的清：

Private Sub cmdEmail_Click()
    Dim outApp As Object
    Dim outMsg As Object
    Dim rptEngdetail As Report
    
    On Error GoTo cmdEmail_Click_Err
    
    ' 初始化Outlook对象
    Set outApp = CreateObject("Outlook.Application")
    Set outMsg = outApp.CreateItem(0) ' 0代表普通邮件项
    
    ' 打开隐藏的目标报表（可根据你原有的筛选逻辑调整参数）
    DoCmd.OpenReport "EngdetailRpt", acViewPreview, , Me.Filter, acHidden
    Set rptEngdetail = Reports("EngdetailRpt")
    
    ' 构建邮件内容（替换成你原有的收件人、主题等逻辑）
    With outMsg
        .To = "指定收件人邮箱"
        .Subject = "工程详情报表"
        .Body = "请查收附件中的工程详情报表。"
        ' 附加报表（如果是生成PDF/快照附加，可替换为对应文件路径）
        .Attachments.Add rptEngdetail.Printer.Port
        .Display ' 若要直接发送可改为.Send，根据你的需求调整
    End With
    
cmdEmail_Click_Exit:
    ' 核心：无论成功/失败，统一清理资源
    ' 关闭并释放报表对象
    If Not rptEngdetail Is Nothing Then
        DoCmd.Close acReport, "EngdetailRpt", acSaveNo
        Set rptEngdetail = Nothing
    End If
    ' 释放Outlook对象，避免进程残留
    If Not outMsg Is Nothing Then
        Set outMsg = Nothing
    End If
    If Not outApp Is Nothing Then
        Set outApp = Nothing
    End If
    ' 重置窗体筛选状态，防止下次复用旧条件
    Me.Filter = ""
    Me.FilterOn = False
    Exit Sub

cmdEmail_Click_Err:
    ' 弹出错误提示（也可改为写入日志）
    MsgBox "发送邮件时出错: " & Err.Description & vbCrLf & "错误代码: " & Err.Number, vbExclamation
    ' 跳转到资源清理步骤，避免资源泄漏
    Resume cmdEmail_Click_Exit
End Sub

关键改进说明： #

• 统一资源清理块：新增cmdEmail_Click_Exit标签，不管代码正常执行完成还是触发错误，都会执行这里的清理逻辑，从根源避免资源残留。
• 显式释放对象：彻底关闭报表、释放Outlook对象，防止出现进程残留或数据库锁定的情况。
• 强制重置筛选：清空窗体的筛选条件，确保下次发送时不会复用上次的筛选值。
• 错误后跳转清理：错误发生后不直接终止程序，而是先完成所有资源清理再退出，杜绝遗留问题。

如果你的原代码中用到了其他资源（比如临时记录集、查询对象），记得在cmdEmail_Click_Exit块中对应添加释放/关闭的逻辑。

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