Consulting

Results 1 to 5 of 5

Thread: Outlook - open hyperlink in received email and send

  1. #1
    VBAX Newbie
    Joined
    Sep 2016
    Posts
    3
    Location

    Outlook - 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.

  2. #2
    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)

    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Newbie
    Joined
    Sep 2016
    Posts
    3
    Location
    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?

  4. #4
    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

    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    VBAX Newbie
    Joined
    Sep 2016
    Posts
    3
    Location
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •