Auto clicking Hyperlink in outlook

[rhyme2henry]

Operating system::    windows 11
Outlook version:     outlook 365 classic
Email type or host:    gmail

---

Hi Lady Diane,

I know you've addressed this issue many times on various forums over the years. Despite trying numerous solutions, I'm still struggling. As a novice, I need a way to automatically click a link in a recurring email in Outlook—something to handle this repetitive task.

I'm open to a call with anyone who can assist. I've enabled developer mode, added macros, and allowed scripts to run in Outlook 365, but something still isn't working.

Thank you for your help!

 

[Diane Poremsky]

I have this macro -

Open Hyperlinks in an Outlook Email Message

Use an Outlook macro to open every hyperlink in the selected email message or open hyperlinks in every message in the selected folder.

www.slipstick.com

 

[Hornblower409]

A simplified version of what I usually use for something like this.

Public Sub TEST_OpenHyperlinks()

    Dim oItem As Object
    Set oItem = Application.ActiveExplorer.Selection.Item(1)

    Dim wDoc As Word.Document
    Set wDoc = oItem.GetInspector.WordEditor
    
    Dim oHyperlinks As Word.Hyperlinks
    Set oHyperlinks = wDoc.Hyperlinks
    
    Dim oHyperlink As Word.Hyperlink
    For Each oHyperlink In oHyperlinks
        wDoc.FollowHyperlink Address:=oHyperlink.Address, NewWindow:=True, AddHistory:=False
    Next oHyperlink

End Sub

 

[Hornblower409]

Forgot the filter part.

Public Sub TEST_OpenHyperlinks()

    Dim oItem As Object
    Set oItem = Application.ActiveExplorer.Selection.Item(1)

    Dim wDoc As Word.Document
    Set wDoc = oItem.GetInspector.WordEditor
    
    Dim oHyperlinks As Word.Hyperlinks
    Set oHyperlinks = wDoc.Hyperlinks
    
    Dim oHyperlink As Word.Hyperlink
    
    For Each oHyperlink In oHyperlinks: Do
    
        Dim sAddress As String
        sAddress = oHyperlink.Address
        
        '   Skip links.
        '   (Stack up Ifs for multiple critera)
        '
        If InStr(1, sAddress, "mailto:") Then Exit Do
        
        wDoc.FollowHyperlink Address:=oHyperlink.Address, NewWindow:=True, AddHistory:=False

    Loop While False: Next oHyperlink

End Sub

 

[Hornblower409]

Oops. Forgot to Close my Inspector.

Public Sub TEST_OpenHyperlinks()

    Dim oItem As Object
    Set oItem = Application.ActiveExplorer.Selection.Item(1)

    Dim oInspector As Outlook.Inspector
    Set oInspector = oItem.GetInspector
    
    Dim wDoc As Word.Document
    Set wDoc = oInspector.WordEditor
    
    Dim oHyperlinks As Word.Hyperlinks
    Set oHyperlinks = wDoc.Hyperlinks
    
    Dim oHyperlink As Word.Hyperlink
    Dim sAddress As String
    Dim sText As String
    For Each oHyperlink In oHyperlinks: Do
    
        sAddress = oHyperlink.Address
        sText = oHyperlink.Range.Text
        
        Select Case True
        
            '   Open these
            '
            Case InStr(1, sAddress, "wintools.info")
            Case sText = "Contact Us"
            
            '   Skip all the rest
            '
            Case Else: Exit Do
        
        End Select
        
        wDoc.FollowHyperlink Address:=oHyperlink.Address, NewWindow:=True, AddHistory:=False

    Loop While False: Next oHyperlink
    
    oInspector.Close Outlook.OlInspectorClose.olDiscard

End Sub

 

[rhyme2henry]

Forgot the filter part.

Public Sub TEST_OpenHyperlinks()

    Dim oItem As Object
    Set oItem = Application.ActiveExplorer.Selection.Item(1)

    Dim wDoc As Word.Document
    Set wDoc = oItem.GetInspector.WordEditor
   
    Dim oHyperlinks As Word.Hyperlinks
    Set oHyperlinks = wDoc.Hyperlinks
   
    Dim oHyperlink As Word.Hyperlink
   
    For Each oHyperlink In oHyperlinks: Do
   
        Dim sAddress As String
        sAddress = oHyperlink.Address
       
        '   Skip links.
        '   (Stack up Ifs for multiple critera)
        '
        If InStr(1, sAddress, "mailto:") Then Exit Do
       
        wDoc.FollowHyperlink Address:=oHyperlink.Address, NewWindow:=True, AddHistory:=False

    Loop While False: Next oHyperlink

End Sub

Hi Hornblower,

This code seems to work fine for my need, but I cannot create a rule because it doesn't appear as a script. is there something you think I am missing? see screenshot attached.
Also, it opens all the links in the email, can you please include filter that opens only the hyperlink whose display text says "click to Acknowledge" this is to prevent it from opening all hyperlinks in the mail.
Lady Diane, can you help?

 

[rhyme2henry]

Hi Hornblower,

This code seems to work fine for my need, but I cannot create a rule because it doesn't appear as a script. is there something you think I am missing? see screenshot attached.
Also, it opens all the links in the email, can you please include filter that opens only the hyperlink whose display text says "click to Acknowledge" this is to prevent it from opening all hyperlinks in the mail.
Lady Diane, can you help?

View attachment 4458

Hi Hornblower, I think I figured out the part about using the macro as a rule, the only pending request is the filtering to prevent it from clicking on all links in the email including images. I need it to open only a specific link with text "click to acknowledge" thanks

 

[Hornblower409]

Public Sub TEST_OpenHyperlinksRule(oItem As Outlook.MailItem)

    Dim oInspector As Outlook.Inspector
    Set oInspector = oItem.GetInspector
    
    Dim wDoc As Word.Document
    Set wDoc = oInspector.WordEditor
    
    Dim oHyperlinks As Word.Hyperlinks
    Set oHyperlinks = wDoc.Hyperlinks
    
    Dim oHyperlink As Word.Hyperlink
    Dim sAddress As String
    Dim sText As String
    For Each oHyperlink In oHyperlinks: Do
    
        sAddress = oHyperlink.Address
        sText = oHyperlink.Range.Text
        
        Select Case True
        
            '   Open these
            '
            Case sText = "click to acknowledge"
            
            '   Skip all the rest
            '
            Case Else: Exit Do
        
        End Select
        
        wDoc.FollowHyperlink Address:=oHyperlink.Address, NewWindow:=True, AddHistory:=False

    Loop While False: Next oHyperlink
    
    oInspector.Close Outlook.OlInspectorClose.olDiscard

End Sub