替换文本断开超链接答案

【问题标题】：Replacing text breaks hyperlink替换文本断开超链接
【发布时间】：2013-09-13 13:18:03
【问题描述】：

以下代码在 Outlook 中的邮件接收事件上执行，并将源自正则表达式匹配的超链接附加到电子邮件底部。代码的后半部分（Reg2 出现的地方）旨在从电子邮件中删除超链接所源自的部分内容。

问题在于，当代码的第二部分执行时，它会破坏超链接（如果我清除了代码的所有 Reg2 替换部分，它们就会正常显示）。不会出现任何错误。

我的目标是用新的超链接替换旧文本，或者至少删除旧文本。

Option Explicit

Sub Starscream(MyMail As MailItem)
    Dim objOL As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim strID As String
    Dim strLink As String
    Dim strNewText As String
    Dim strLinkText As String
    Dim Reg1 As RegExp
    Dim M1 As MatchCollection
    Dim M2 As MatchCollection
    Dim M As Match
    Dim counter As Integer
    Dim strDelete As String
    Dim Reg2 As RegExp

strID = MyMail.EntryID
counter = 4
Set MyMail = Application.Session.GetItemFromID(strID)
Set objOL = Application
strLinkText = "Open Ticket - Impact Level: "

Set Reg1 = New RegExp
    With Reg1
    .Pattern = "https.+?/Operation>"
    .Global = True
End With

Set Reg2 = New RegExp
    With Reg2
    .Pattern = "Alpha[\s\S]*Omega"
    .Global = True
    End With

'make the mail HTML format
If Not MyMail Is Nothing Then
    Set objNS = objOL.Session
    MyMail.BodyFormat = olFormatHTML
End If

If Reg1.test(MyMail.body) Then

    Set M1 = Reg1.Execute(MyMail.body)
    For Each M In M1
        'Change things to hyperlinks here
        strLink = M.Value
        strNewText = "<p><a href=" & Chr(34) & strLink & _
         Chr(34) & ">" & strLinkText & counter & "</a></p></body>"
        MyMail.HTMLBody = Replace(MyMail.HTMLBody, "</body>", _
                      strNewText, 1, 1, vbTextCompare)
        counter = counter - 1
    Next
 End If

 'this is where things stop working
 If Reg2.test(MyMail.body) Then
    Set M2 = Reg2.Execute(MyMail.body)
    For Each M In M2
    strDelete = M.Value
    MyMail.body = Replace(MyMail.body, strDelete, _
                      "", 1, 1, vbTextCompare)
    Next
 End If

MyMail.Save
End Sub

断开的超链接示例：

''HYPERLINK "https://example.com/sdpapi/request/?OPERATION_NAME=ADD_REQUEST&TECHNICIAN_KEY=AC78DFG-CTBOP-AAUIGE-DBBB-12KGLIF&INPUT_DATA=<Operation><Details><requester>HowardStern</requester><subject>MoreInfo</subject><description>Icanhas</description><category>APPIncident</category><subcategory>INTERNAL</subcategory><item>Other</item><priority>P3 Routine</priority><group>*TestTeam </group><department>IT</department><requesttemplate>GENERAL Incident</requesttemplate></Details></Operation>"Open Ticket - Impact Level: 4

【问题讨论】：

将使用Reg1 创建的每个链接添加到集合中，而不是立即将它们附加到 HTML 正文中。在 Reg2 删除步骤之后附加它们。

标签： regex vba outlook hyperlink

【解决方案1】：

您正在设置纯文本 Body 属性。您需要使用 HTMLBody 属性来保留原始格式。

【讨论】：

[我认为您指的是 Reg2.test 部分] 我可以将代码更改为 "MyMail.HTMLBody=...", "MyMail.HTMLBody=Replace(MyMail.HTMLBody... ", 或 "...=Replace(MyMail.HTMLBody..." 并且这些都不起作用，尽管它们的输出略有不同。
输出与我帖子中的原始示例相同（或非常相似）

【解决方案2】：

完成了一个工作迭代，基本上我只需要重新排序一些不同的东西。 Reg1 执行现在填充 M1 集合，然后由 Reg2 部分清理电子邮件，然后将 MyMail 项设置为 HTML 并附加超链接。

If Reg1.test(MyMail.body) Then
  Set M1 = Reg1.Execute(MyMail.body)
 End If

If Reg2.test(MyMail.body) Then
  Set M2 = Reg2.Execute(MyMail.body)
  For Each M In M2
  strDelete = M.Value
  MyMail.body = Replace(MyMail.body, strDelete, _
                  "", 1, 1, vbTextCompare)
Next
End If

If Not MyMail Is Nothing Then
  Set objNS = objOL.Session
  MyMail.BodyFormat = olFormatHTML
End If


For Each M In M1
    strLink = M.Value
    strNewText = "<p><a href=" & Chr(34) & strLink & _
     Chr(34) & ">" & strLinkText & counter & "</a></p></body>"
    MyMail.HTMLBody = Replace(MyMail.HTMLBody, "</body>", _
                  strNewText, 1, 1, vbTextCompare)
    counter = counter - 1
     Next

MyMail.Save
End Sub

【讨论】：