regex - 替换文本断开超链接

Question

以下代码在 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

Answer 1

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

Answer 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