【问题标题】:Remove first line that may include formatted text删除可能包含格式化文本的第一行
【发布时间】:2021-12-05 07:55:17
【问题描述】:

我在发送前编辑我的 Outlook 消息以删除用于内部流程的第一行,以便我可以将电子邮件干净地发送给收件人。

只要第一行中的格式一致,脚本就可以工作。当格式变化时,例如颜色或斜体或粗体的差异,脚本无法删除此行。

无论格式如何,我都在尝试删除此行,同时保留电子邮件正文其余部分的格式。

示例:BAAR-6546543456。
代码将失败并显示 BAAR-6546543456. 或 BAAR-6546543456.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim OutMail As Object
Dim PrintMail As Object
Dim FirstLetters As String
Dim LastPos As Long
Dim sHostName As String
Dim DirectoryLine As String

On Error GoTo EndTask

Set Item = CreateObject("Outlook.Application")
Set OutMail = Item.ActiveInspector.CurrentItem

sHostName = Environ$("username")

FirstLetters = Left(OutMail.Body, 5)
LastPos = InStr(OutMail.Body, ".")

If Right(FirstLetters, 1) = "-" Then
    
    If RecordFlag = "R" Then
        Set objMsg = Application.CreateItem(olMailItem)
            With objMsg
                .Body = "Your document(s) have been dispatched on " & Format(Now(), "yyyy-mm-dd hh:mm:ss")
                .BodyFormat = olFormatHTML ' send HTML
                .Display
            End With
        Set PrintMail = Item.ActiveInspector.CurrentItem
    Else
        Dispatch_remark = " Dispatched to " & OutMail.To & "; " & OutMail.CC & " on " & Format(Now(), "yyyy-mm-dd hh:mm:ss")
        OutMail.HTMLBody = OutMail.HTMLBody & Dispatch_remark
        Set PrintMail = Item.ActiveInspector.CurrentItem
    End If

    Processing (this is the internal piece which is out of scope of this question)
    
    OutMail.HTMLBody = Replace(OutMail.HTMLBody, DirectoryLine, "", , , 1)
    
    If RecordFlag = "R" Then
        objMsg.Delete
    Else
        OutMail.HTMLBody = Replace(OutMail.HTMLBody, Trim(Dispatch_remark), "", 1)
    End If

End If

Set objMsg = Nothing
Set OutMail = Nothing
Set PrintMail = Nothing
Set Item = Nothing

EndTask:

End Sub

我的重点是脚本的 Replace 方法部分,格式不一致时会失败:

    OutMail.HTMLBody = Replace(OutMail.HTMLBody, DirectoryLine, "", , , 1)
    
    If RecordFlag = "R" Then
        objMsg.Delete
    Else
        OutMail.HTMLBody = Replace(OutMail.HTMLBody, Trim(Dispatch_remark), "", 1)
    End If

【问题讨论】:

  • 您能否在替换中使用OutMail.Body 属性而不是OutMail.HTMLBody,以排除HTML 格式?

标签: vba outlook


【解决方案1】:

此代码检查活动邮件并有两种方法删除您想要的行。第一个是注释的,如果您确定要删除的行是邮件的第一个,则可以使用它。如果不是,你应该循环部分。 选择您想要的方式并适应您的代码。

Sub Mail_DeleteParagraph()
    Dim Ins As Object: Set Ins = Application.ActiveInspector
    Dim Doc As Object: Set Doc = Ins.WordEditor
    Dim oPara As Object
    
    ' Delete first paragraph
    'Set oPara = Doc.Paragraphs(1).Range
    'oPara.Delete
    
    ' Delete paragraph that starts with 'BAAR-' and has '.'
    Dim i As Integer
    For Each oPara In Doc.Paragraphs
        Debug.Print i & " - " & oPara.Range
        If Left(oPara.Range, 5) = "BAAR-" And InStr(1, oPara.Range, ".") > 0 Then
            oPara.Range.Delete
            exit sub
        End If
        i = i + 1
    Next oPara
End Sub

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2015-04-24
    • 1970-01-01
    • 2018-03-15
    • 2011-02-27
    • 1970-01-01
    • 2011-07-04
    相关资源
    最近更新 更多