How do I automatically open link in email? Outlook macro

Aug 27, 2017
Reaction score
I wonder if anybody could help me. I would like to automatically open a specific "accept" link (which is not the first link on the email, it's the third) and leave the other links alone (especially the "reject" link!).

I have tried to modify the script that a lady (Diane?) kindly attached with reference as to how to open ALL links automatically. I tried this by adding words in the other hyperlinks to hopefully skip over them, to no avail (I'm a complete novice), that she used with unsubscribe. All the links keep on being activated. Is there any way I could just have the third hyperlink activated in my email - it has the word "accept" in the linked URL and the other URL has the word "reject".

I will show you what I have at the moment to try and exclude the other links:

Option Explicit
Public Sub OpenAllMessageLinks(Item As Outlook.MailItem)
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 oApp As Object

Set objOL = Outlook.Application
Set objFolder = objOL.ActiveExplorer.CurrentFolder
Set objItems = objFolder.Items

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

Set Reg1 = New RegExp

On Error Resume Next

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 InStr(strURL, "reject") Then GoTo NextURL
If InStr(strURL, "newsletter") Then GoTo NextURL
If InStr(strURL, "") Then GoTo NextURL
If InStr(strURL, "") Then GoTo NextURL
If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)

Shell (browserPath & " -url " & strURL)

End If

End With
Set Reg1 = Nothing
Set objItems = Nothing
Set objFolder = Nothing
Set objOL = Nothing
End Sub

The ones in pink are the added "code" that I'm playing about with, to try and exclude all the other hyperlinks - it doesn't work - they all keep opening.

Any help gratefully received

Feb 8, 2018
Reaction score
mailto: (mail) ????

No space between mailto: and (mail). I hate the emojis.

Hope this helps :)

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question