I tweaked the macro (shown below) to provide the result I need. I noticed your code used oLink.emailsubject to separate out the subject line, which seems to work without further intervention. And with oLink.address, I noticed you had to separate the address portion using LEFT and INSTR.
- I realized that the body message I need to reply with was contained within the subject line of the hyperlink. However, I had to use oLink.address and then further separate out using RIGHT, LEN, and INSTR. Is there a more efficient way to do this? I tried using oLink.body to extract the body portion but that didn’t work.
- Also wondering if there is a method to decode all the URLs instead of having to manually specify each character replacement (i.e. replace %20 with chr(32), %21 with “!”, etc.).
Thanks again.
Option Explicit
Sub TestMsg()
Dim olMsg As MailItem
On Error Resume Next
Set olMsg = ActiveExplorer.Selection.Item(1)
GetLink olMsg
lbl_Exit:
Exit Sub
End Sub
Sub GetLink(olItem As MailItem)
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim oLink As Object
Dim olNewItem As MailItem
Dim strAddress As String
Dim strSubject As String
Dim strBody As String
With olItem
.BodyFormat = olFormatHTML
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
For Each oLink In oRng.Hyperlinks
If oLink.TextToDisplay = "Approve" Then
Set olNewItem = CreateItem(0)
With olNewItem
strAddress = Left(oLink.Address, InStr(1, oLink.Address, "?") - 1)
strAddress = Replace(strAddress, "mailto:", "")
strAddress = Replace(strAddress, "%2B", "+")
strSubject = Replace(oLink.emailsubject, "%20", Chr(32))
strBody = Right(oLink.Address, Len(oLink.Address) - InStr(1, oLink.Address, "body=") - 4)
strBody = Replace(strBody, "%5B", "[")
strBody = Replace(strBody, "%3A", ":")
strBody = Replace(strBody, "%20", Chr(32))
strBody = Replace(strBody, "%5D", "]")
strBody = Replace(strBody, "%0A", Chr(10))
strBody = Replace(strBody, "%2C", ",")
strBody = Replace(strBody, "%21", "!")
strBody = Replace(strBody, "%3B", ";")
'repeat to replace any other codes used.
.To = strAddress
.Subject = strSubject
.Body = strBody
.Display
'.Send 'Restore after testing
End With
olItem.Close olDiscard
Exit For
End If
Next oLink
End With
lbl_Exit:
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Set oLink = Nothing
Exit Sub
End Sub