Open hyperlink in received email and send

Hi, I was trying to run a macro when an email is received from a specific sender. Once that happens and the macro is triggered, I'd like it to open a hyperlink within the body of that email based on the display text of the hyperlink (since there are multiple hyperlinks, I only want to open the 1 link that has the display text of "Approve"). Once this link opens, it opens another email where I have to press send. I would also like it to send this new email that pops up automatically.

Does anyone know how this can be accomplished? Please let me know, thanks.

Without knowing more about the messages, it is not possible to be specific, but the following should be close. You can run the main macro from a rule that identifies the incoming message (but I have included a macro to test with a selected message)

Code:

---

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, olNewInsp As Outlook.Inspector
    Dim wdDoc As Object, wdNewDoc As Object
    Dim oRng As Object, oNewRng As Object
    Dim oLink As Object
    Dim olNewItem As MailItem
    Dim strAddress 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 = olItem.Reply
                With olNewItem
                    strAddress = oLink.Address
                    strAddress = Replace(strAddress, "mailto:", "")
                    strAddress = Left(strAddress, InStr(1, strAddress, "?") - 1)
                    .To = strAddress
                    Set olNewInsp = .GetInspector
                    Set wdNewDoc = olNewInsp.WordEditor
                    Set oNewRng = wdNewDoc.Range(0, 0)
                    .Display
                    oNewRng.Text = "This is the covering message text"
                    '.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

---

Thanks gmayor, that gets me closer to what I was looking to accomplish. However, I was trying to replicate the same effect as clicking on the hyperlink. There doesn't seem to be any code to activate the link, so I suppose it has to be done another way?

The email address in the Edit Hyperlink box displays in percent code form. And so a "%2B" should actually display as a "+". Additionally, the subject line in the Edit Hyperlink box displayed in percent code format as well, which I need to translate to legible sentences. And it seems to include both the subject and the body message in the one line which I need to separate out in to their respective locations in the email draft.
Could you please advise?

Without knowing what is in the link, it is difficult to address the range of possibilities, but the following should work, and if you need to add more codes, they are listed at http://www.w3schools.com/tags/ref_urlencode.asp

Clicking an e-mail Hyperlink does not send a reply as in my earlier code, but creates a new message. I have modified the code to do that. You can change or omit the message text (oNewRng.Text = "This is the covering message text") as appropriate

Code:

---

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, olNewInsp As Outlook.Inspector
    Dim wdDoc As Object, wdNewDoc As Object
    Dim oRng As Object, oNewRng As Object
    Dim oLink As Object
    Dim olNewItem As MailItem
    Dim strAddress As String
    Dim strSubject 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 = oLink.Address
                    strAddress = Replace(strAddress, "mailto:", "")
                    strAddress = Left(strAddress, InStr(1, strAddress, "?") - 1)
                    strSubject = Replace(oLink.emailsubject, "%20", Chr(32))
                    strSubject = Replace(strSubject, "%2B", "+")
                    'repeat to replace any other codes used.
                    .To = strAddress
                    .Subject = strSubject
                    Set olNewInsp = .GetInspector
                    Set wdNewDoc = olNewInsp.WordEditor
                    Set oNewRng = wdNewDoc.Range(0, 0)
                    .Display
                    oNewRng.Text = "This is the covering message text"
                    '.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

---

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.

Code:

---

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

---