Open hyperlink in received email and send

[dmhcdk]

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.

1. 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.
2. 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