次のコードは、Outlook のメッセージ受信イベントで実行され、正規表現の一致から派生したハイパーリンクを電子メールの下部に追加します。コードの後半部分 (Reg2 が入る部分) は、ハイパーリンクの元となった電子メールからコンテンツの一部を削除することを目的としています。
問題は、コードの 2 番目の部分が実行されると、ハイパーリンクが壊れることです (コードの 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