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

替换文本会破坏超链接

2 个答案: