You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

VBA开发咨询:Lotus Notes邮件转发时自动移除默认签名的方法

你遇到的签名自动插入问题是因为使用NotesUIWorkspace相关的UI接口操作时,Lotus Notes客户端会默认给新建/转发的邮件注入预设签名,只要走UI交互逻辑就会触发这个规则。下面给出两种可行解决方案:

方案1:改用后端对象实现转发(推荐)

完全绕开UI接口,直接调用Lotus Notes的后端对象构建转发邮件,不会触发签名插入逻辑,同时不需要依赖Sleep等待UI加载,稳定性和运行效率更高。
修改后的代码如下:

Public Sub Forward_Email(findSubjectLike As String, forwardToEmailAddresses As String)
    Dim NSession As Object
    Dim NMailDb As Object
    Dim NInboxView As Object
    Dim NOriginDoc As Object
    Dim NFwdDoc As Object
    Dim NRTItem As Object
    Dim v As Variant
    
    Set NSession = CreateObject("Notes.NotesSession")
    Set NMailDb = NSession.CurrentDatabase
    
    ' 定位收件箱文件夹
    For Each v In NMailDb.Views
        If v.IsFolder And v.Name = "($Inbox)" Then
            Set NInboxView = v
            Exit For
        End If
    Next
    
    Set NOriginDoc = Find_Document(NInboxView, findSubjectLike)
    If Not NOriginDoc Is Nothing Then
        ' 直接在后端创建转发文档,不走UI交互
        Set NFwdDoc = NOriginDoc.CopyToDatabase(NMailDb)
        ' 设置邮件基础属性
        NFwdDoc.Form = "Memo"
        NFwdDoc.SendTo = Split(forwardToEmailAddresses, ";") ' 多收件人用分号分隔时自动拆分
        NFwdDoc.Subject = "Fwd: " & NOriginDoc.GetItemValue("Subject")(0)
        ' 清除默认生成的原有Body内容
        If NFwdDoc.HasItem("Body") Then Call NFwdDoc.RemoveItem("Body")
        ' 新建富文本Body项,导入自定义HTML
        Set NRTItem = NFwdDoc.CreateRichTextItem("Body")
        Call NRTItem.Import("HTML File", "HTML FILE DIRECTORY") ' 替换为你的HTML文件实际路径
        ' 直接发送
        Call NFwdDoc.Send(False)
        MsgBox "邮件转发成功"
    Else
        MsgBox vbCrLf & findSubjectLike & vbCrLf & "未在收件箱中找到"
    End If
    
    ' 释放对象资源
    Set NRTItem = Nothing
    Set NFwdDoc = Nothing
    Set NOriginDoc = Nothing
    Set NInboxView = Nothing
    Set NMailDb = Nothing
    Set NSession = Nothing
End Sub

' Find_Document函数无需修改,直接复用原有逻辑即可
Private Function Find_Document(NView As Object, findSubjectLike As String) As Object
    Dim NThisDoc As Object
    Dim thisSubject As String
   
    Set Find_Document = Nothing
   
    Set NThisDoc = NView.GetFirstDocument
    While Not NThisDoc Is Nothing And Find_Document Is Nothing
        thisSubject = NThisDoc.GetItemValue("Subject")(0)
        If LCase(thisSubject) = LCase(findSubjectLike) Then Set Find_Document = NThisDoc
        Set NThisDoc = NView.GetNextDocument(NThisDoc)
    Wend
End Function

方案2:保留现有UI逻辑,手动清除签名

如果不想大幅改动现有代码,可以在导入HTML之前先清空Body字段的所有内容,把自动生成的转发原文和默认签名一起删掉,再导入你的自定义HTML:
找到原代码中NFwdUIDocument.GoToField "Body"这一行,在后面添加两行代码即可:

NFwdUIDocument.GoToField "Body"
' 新增以下两行,全选并清空Body原有内容(包含默认签名)
NFwdUIDocument.SelectAll
NFwdUIDocument.Clear
NFwdUIDocument.Import "HTML File", "HTML FILE DIRECTORY"
NFwdUIDocument.InsertText vbLf

注意这个方案依赖UI操作的完成状态,如果遇到客户端卡顿,可能需要适当延长Sleep的时间避免清除失效。

内容的提问来源于stack exchange,提问作者Drawleeh

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.10.01 07:45:02