October 10 2018: Updated the macros to use the default browser.

I need to find the link in an unread email in my inbox and open it.

This macro goes through an email message and opens each hyperlink (HTTP or HTTPS) in a new tab in your default browser. The second macro loops though all messages in a folder, opening all links in each message. Both macro skip links which contain the word "unsubscribe".

Warning! This has the potential to lock up your computer if you run it on a message containing a lot of hyperlinks. Use it with care!

To open only the first link in a message, change .Global = True to .Global = False.

You will need to add a reference to the Microsoft VBScript Regular Expressions library in Tools, References!

If you are using 64-bit Office, the Private Declare Function ShellExecute macro will be in red - you need you use this as the first line, with PtrSafe between Declare Function:
Private Declare PtrSafe Function ShellExecute _

Private Declare Function ShellExecute _
  Lib "shell32.dll" Alias "ShellExecuteA" ( _
  ByVal hWnd As Long, _
  ByVal Operation As String, _
  ByVal Filename As String, _
  Optional ByVal Parameters As String, _
  Optional ByVal Directory As String, _
  Optional ByVal WindowStyle As Long = vbMinimizedFocus _
  ) As Long

Sub OpenLinksMessage()
 Dim olMail As Outlook.MailItem
 Dim Reg1 As RegExp
 Dim M1 As MatchCollection
 Dim M As Match
 Dim strURL As String
Dim lSuccess As Long

Set olMail = Application.ActiveExplorer().Selection(1)

Set Reg1 = New RegExp

With Reg1
 .Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$%;_])*)"
 .Global = True
 .IgnoreCase = True
 End With

If Reg1.Test(olMail.Body) Then

Set M1 = Reg1.Execute(olMail.Body)
 For Each M In M1
   strURL = M.SubMatches(0)
    Debug.Print strURL
   If InStr(strURL, "unsubscribe") Then GoTo NextURL
   If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)

   lSuccess = ShellExecute(0, "Open", strURL)
  DoEvents

NextURL:
  Next
  End If

Set Reg1 = Nothing
 End Sub

Open All Hyperlinks in all Messages

This macro opens the links in all messages in the selected folder.

Warning! This has the potential to lock up your computer. Use it with care and on a folder containing a limited number of messages!

Option Explicit
' 64bit office use: 
'Private Declare PtrSafe Function ShellExecute _
Private Declare Function ShellExecute _
  Lib "shell32.dll" Alias "ShellExecuteA" ( _
  ByVal hWnd As Long, _
  ByVal Operation As String, _
  ByVal Filename As String, _
  Optional ByVal Parameters As String, _
  Optional ByVal Directory As String, _
  Optional ByVal WindowStyle As Long = vbMinimizedFocus _
  ) As Long

Public Sub OpenAllMessageLinks()
    Dim objOL As Outlook.Application
    Dim objItems As Outlook.Items
    Dim objFolder As Outlook.MAPIFolder
    Dim olMail As Outlook.MailItem
    Dim Reg1 As RegExp
    Dim M1 As MatchCollection
    Dim M As Match
    Dim strURL As String
    Dim lSuccess As Long
  
    Set objOL = Outlook.Application
    Set objFolder = objOL.ActiveExplorer.CurrentFolder
    Set objItems = objFolder.Items
    Set Reg1 = New RegExp
     
    For Each olMail In objItems
  
    With olMail
    With Reg1
        .Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$%;_])*)"
        .Global = True
        .IgnoreCase = True
    End With
     
    If Reg1.Test(olMail.Body) Then
      
        Set M1 = Reg1.Execute(olMail.Body)
        For Each M In M1
            strURL = M.SubMatches(0)
            Debug.Print strURL
       If InStr(strURL, "unsubscribe") Then GoTo NextURL
   If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)

      lSuccess = ShellExecute(0, "Open", strURL)

NextURL:
         Next
    End If
                
    End With
    Next
    Set Reg1 = Nothing
    Set objItems = Nothing
    Set objFolder = Nothing
    Set objOL = Nothing
End Sub

Open a specific hyperlink

If you want to open a link that is linked to a specific Hyperlink keyword, you'll need to find the keyword and url.

For example, in this screenshot, I have 10 links and want to open the fifth link, "View this thread". To do that, I need to include View this thread in the pattern search.

The hyperlink should be seen by VBA in this format: View this thread <https://URL>. You can confirm by adding Debug.Print olMail.Body to the macro then looking at the code in the Immediate window.

' 64bit office use: 
'Private Declare PtrSafe Function ShellExecute _
Private Declare Function ShellExecute _
  Lib "shell32.dll" Alias "ShellExecuteA" ( _
  ByVal hWnd As Long, _
  ByVal Operation As String, _
  ByVal Filename As String, _
  Optional ByVal Parameters As String, _
  Optional ByVal Directory As String, _
  Optional ByVal WindowStyle As Long = vbMinimizedFocus _
  ) As Long

Sub OpenHyperLinkMessage()
 Dim olMail As Outlook.MailItem
 Dim Reg1 As RegExp
 Dim M1 As MatchCollection
 Dim M As Match
 Dim strURL As String
Dim lSuccess As Long

Set olMail = Application.ActiveExplorer().Selection(1)

Set Reg1 = New RegExp

With Reg1
 .Pattern = "View this thread <(.*)>"
 .Global = True
 .IgnoreCase = True
 End With

If Reg1.Test(olMail.Body) Then
Set M1 = Reg1.Execute(olMail.Body)
 For Each M In M1
   strURL = M.SubMatches(0)
    Debug.Print strURL
   If InStr(strURL, "unsubscribe") Then GoTo NextURL
   If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)

lSuccess = ShellExecute(0, "Open", strURL)

NextURL:
  Next
  End If

Set Reg1 = Nothing
 End Sub

Open links in selected messages

This version of the macro opens links in the selected messages in any folder.

This macro only opens links that contains the word 'support' somewhere in the path. Remove that link from the code to open all links.

If InStr(strURL, "support") = 0 Then GoTo NextURL

To skip images, add this line:
If InStr(strURL, ".png") Then GoTo NextURL

Option Explicit
' 64bit office use: 
'Private Declare PtrSafe Function ShellExecute
Private Declare PtrSafe Function ShellExecute _
  Lib "shell32.dll" Alias "ShellExecuteA" ( _
  ByVal hWnd As Long, _
  ByVal Operation As String, _
  ByVal Filename As String, _
  Optional ByVal Parameters As String, _
  Optional ByVal Directory As String, _
  Optional ByVal WindowStyle As Long = vbMinimizedFocus _
  ) As Long

Public Sub SelectedMessageLinks()
    Dim objOL As Outlook.Application
    Dim currentExplorer As Explorer
    Dim Selection As Selection
    Dim olMail As Object ' Outlook.MailItem
    Dim Reg1 As RegExp
    Dim M1 As MatchCollection
    Dim M As Match
    Dim strURL As String
    Dim lSuccess As Long

    Set objOL = Outlook.Application
    Set currentExplorer = objOL.ActiveExplorer
    Set Selection = currentExplorer.Selection

    Set Reg1 = New RegExp
     
    For Each olMail In Selection
  
    With olMail
    With Reg1
        .Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$%;_])*)"
        .Global = True
        .IgnoreCase = True
    End With
     
   If Reg1.Test(olMail.Body) Then
      
     Set M1 = Reg1.Execute(olMail.Body)
       For Each M In M1
         strURL = M.SubMatches(0)
          Debug.Print strURL
     If InStr(strURL, "unsubscribe") Then GoTo NextURL
     If InStr(strURL, "index") = 0 Then GoTo NextURL 
     If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)
     
   lSuccess = ShellExecute(0, "Open", strURL)
  
NextURL:
     Next
   End If
                
    End With
    Next
    Set olMail = Nothing
    Set Reg1 = Nothing
    Set objOL = Nothing
End Sub

Run a Script Rule

Use this macro in a run a script rule to open the first link in a message.

' 64bit office use: 
'Private Declare PtrSafe Function ShellExecute _
Private Declare Function ShellExecute _
  Lib "shell32.dll" Alias "ShellExecuteA" ( _
  ByVal hWnd As Long, _
  ByVal Operation As String, _
  ByVal Filename As String, _
  Optional ByVal Parameters As String, _
  Optional ByVal Directory As String, _
  Optional ByVal WindowStyle As Long = vbMinimizedFocus _
  ) As Long

Public Sub OpenLinks(olMail As Outlook.MailItem)

 Dim Reg1 As RegExp
 Dim M1 As MatchCollection
 Dim M As Match
 Dim strURL As String
 Dim lSuccess As Long

Set Reg1 = New RegExp

With Reg1
 .Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$%;_])*)>"
 .Global =  True
 .IgnoreCase = True
 End With

If Reg1.test(olMail.Body) Then

Set M1 = Reg1.Execute(olMail.Body)
 For Each M In M1
   strURL = M.SubMatches(0)
   Debug.Print strURL

lSuccess = ShellExecute(0, "Open", strURL)

  Next
  End If

Set Reg1 = Nothing
Set oApp = Nothing

 End Sub

The following is a stub macro for testing the run a script rule without the need to send messages to trigger. Select a message and run the RunScript macro.

Sub RunScript()
Dim objApp As Outlook.Application
Dim objItem As MailItem
Set objApp = Application
Set objItem = objApp.ActiveExplorer.Selection.Item(1)

'macro name you want to run goes here
OpenLinks objItem

End Sub

Using the OpenLinks Run a Script Macro Video Tutorial

Use with Chrome or FireFox

To use Chrome, FireFox, or another browser with this macro, you need to add the path to the browser to the macro then pass the URL to it.

Sub OpenLinksMessage()
 Dim olMail As Outlook.MailItem
 Dim Reg1 As RegExp
 Dim M1 As MatchCollection
 Dim M As Match
 Dim strURL As String

Dim browserPath As String
browserPath = Chr(34) & "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" & Chr(34)
 
Set olMail = Application.ActiveExplorer().Selection(1)
 
Set Reg1 = New RegExp
 
With Reg1
 .Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$%;_])*)"
' opens the first link. use false to open all
 .Global = False
 .IgnoreCase = True
 End With
 
If Reg1.Test(olMail.Body) Then
 
Set M1 = Reg1.Execute(olMail.Body)
 For Each M In M1
   strURL = M.SubMatches(0)
   If InStr(strURL, "unsubscribe") Then GoTo NextURL
   If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)
  
  Shell (browserPath & " -url " & strURL)
  DoEvents
 
NextURL:
  Next
  End If
 
Set Reg1 = Nothing
 End Sub

Run a script version for Chrome

This run a script macro will work with other browsers.

If you aren't using Chrome, change the path to your browser.

This version opens all links in the message; if you only want to open the first link, change .Global = True to .Global = False.

Sub OpenLinksMessage(olMail As Outlook.MailItem)
 Dim Reg1 As RegExp
 Dim M1 As MatchCollection
 Dim M As Match
 Dim strURL As String

Dim browserPath As String
browserPath = Chr(34) & "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" & Chr(34)
 
Set Reg1 = New RegExp

With Reg1
 .Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$%;_])*)"
' opens all links, false to open first
 .Global = True
 .IgnoreCase = True
 End With
 
If Reg1.Test(olMail.Body) Then
 
Set M1 = Reg1.Execute(olMail.Body)
 For Each M In M1
   strURL = M.SubMatches(0)

' skips links containing the word 'unsubscribe'
If InStr(strURL, "unsubscribe") Then GoTo NextURL

If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)
  
  Shell (browserPath & " -url " & strURL)
  DoEvents
 
NextURL:
  Next
  End If
 
Set Reg1 = Nothing
 End Sub

Open the Links in Internet Explorer

This is the original macro, before changing the code to use the default browser.

CLng(2048) in this line tells IE to use a new tab: oApp.navigate strURL, CLng(2048). Use just oApp.navigate strURL if you want to open the link in the current tab.

Sub OpenLinksMessage()
 Dim olMail As Outlook.MailItem
 Dim Reg1 As RegExp
 Dim M1 As MatchCollection
 Dim M As Match
 Dim strURL As String
Dim oApp As Object
Set oApp = CreateObject("InternetExplorer.Application")

Set olMail = Application.ActiveExplorer().Selection(1)

Set Reg1 = New RegExp

With Reg1
 .Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$%;_])*)"
 .Global = True
 .IgnoreCase = True
 End With

If Reg1.Test(olMail.Body) Then

Set M1 = Reg1.Execute(olMail.Body)
 For Each M In M1
   strURL = M.SubMatches(0)
    Debug.Print strURL
   If InStr(strURL, "unsubscribe") Then GoTo NextURL
   If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)
   oApp.navigate strURL, CLng(2048)
   oApp.Visible = True

'wait for page to load before passing the web URL
  Do While oApp.Busy
  DoEvents
  Loop

 NextURL:
  Next
  End If

Set Reg1 = Nothing
 End Sub

Get the Page Title

What if you just need to grab the page title of the link?

Sub GetPageTitle()
 Dim olMail As Outlook.MailItem
 Dim Reg1 As RegExp
 Dim M1 As MatchCollection
 Dim M As Match
 Dim strURL As String
 Dim objHttp As Object
 Dim title As String

Set olMail = Application.ActiveExplorer().Selection(1)

Set Reg1 = New RegExp

With Reg1
 .Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$%;_])*)"
 .Global = True
 .IgnoreCase = True
 End With

If Reg1.Test(olMail.Body) Then

Set M1 = Reg1.Execute(olMail.Body)
 For Each M In M1
   strURL = M.SubMatches(0)
    Debug.Print strURL
If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)

Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")
objHttp.Open "GET", strURL, False
objHttp.Send ""

title = ""
title = objHttp.ResponseText

If InStr(1, UCase(title), "<TITLE>") Then
    title = Mid(title, InStr(1, UCase(title), "<TITLE>") + Len("<TITLE>"))
    title = Mid(title, 1, InStr(1, UCase(title), "</TITLE>") - 1)
Else
    title = ""
End If

Debug.Print title

NextURL:
  Next
  End If

Set Reg1 = Nothing
 End Sub

How to use macros

First: You will need macro security set to low during testing.

To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.

After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.

Open the VBA Editor by pressing Alt+F11 on your keyboard.

To put the code in a module:

1. Right click on Project1 and choose Insert > Module
2. Copy and paste the macro into the new module.

More information as well as screenshots are at How to use the VBA Editor