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:
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
More information as well as screenshots are at How to use the VBA Editor
More Information
Automatically open link in email received (Outlook Forums)
hi Diane! Thank you so much for all the details. i am using below code but i want to save this to the specific folder instead of browser path. can you help?
Sub OpenLinksMessage(olMail As Outlook.MailItem)
Dim Reg1 As RegExp
Dim M1 As MatchCollection
Dim M As Match
Dim strURL As String
Dim URLstr As String
Dim imgsrc As String
Dim browserPath As String
Dim dlpath 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 = 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)
' 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
Hello everyone,
Does anyone here has tried to create a vba which will sends email notification when a user clicked on a link inside the email body?
Thanks in advance.
Will it be watching you to click on links or watching people you sent mail to?
I don't think its possible to watch just for link clicks - but it is definitely not possible to do it on messages you send. There are easier ways to track people clicking links with coded links.
Thank you so much for the solution! With some adjustments I was able to make it suitable for the Outlook rule, applying it to incoming emails with links to downloadable reports! <3
Hi Diane, FIrst of all thank you so much for this! This is my fist outlook macro and I am relatively new to this, so please bear with me if I ask something obvious. I am trying to open all the links in a received new message, triggered by a rule (name in the subject of the email). I tried all of the macros as instructed and came across the following issues: The first one Sub OpenLinksMessage(): Works fine, I run it in VBA and it opens a page in my browser. However, when I try to create the rule, select "run a script", click on script to select it, it does not appear in the box (from which I'd select it); and When I tried this one Public Sub OpenAllMessageLinks(): I can find and choose it from the "run a script" list with no trouble. However, when I run the code below it in VBA it jumps to (near the end) "ShellExecute" and highlights "Public Sub OpenAllMessageLinks()" in yellow and I get the error message "Compile Error: Sub or Function not defined" lSuccess = ShellExecute(0, "Open", strURL) Could you please point me towards what I might… Read more Âğ
You need to use the run a scrip rule at the end if you want to run it using a rule - Public Sub OpenLinks(olMail As Outlook.MailItem) - but it only opens the first link. Or so it says- .Global = True should open all links.
First of all Diane, I would like to say thank you. One, because I stumbled upon this after watching several youtube channels and some other question answer segments that didnt seem to help. I read you helping another gentleman, and it was awesome how you helped him out.
I have tried and tried and tried and can't seem to make this code/script function properly. Now let me let you know that I have zero coding/scripting knowledge.
I am going to place a link here, and if you're around can you please help me .
This is the link :
https://www.timiosinc.com/VendorSelfAssign/Order.aspx?class=CLO&companyid=08&orderno=nnn&vendorno=nnn&z=nnn&p=nnn
I am using Outlook, and my Default Browser is Chrome located at the following '
C:\Program Files (x86)\Google\Chrome\Application\chrome.exe
Thank you so much . I would greatly appreciate any help that you provide.
That is the url you want to open? What happens when the macro tries to open it? Show the Immediate Window (Ctrl+G or open it from the view menu) - the Debug.print strURL will print the found url in the window - is it correct?
Hi Diane, While googling I stumbled upon your this article. Thanks for sharing this with the world. This is so helpful and knowledgeable for people like me who know very little about VBA coding! Thanks again! I was actually looking for a simple Outlook macro on google but could not find anything similar so thought to write it to you for your help. Well! honestly speaking, I am not expecting a full solution from you as probably your time is more valuable than mine :) .. Even if you can just let me know if there is a solution possible for below problem, that would be enough for me too. And if you can give a full solution, what to say! I will be very much thankful to you. So, I was looking for a Outlook macro which is when run, copies the selected text from an email (the text could be either in the email body or subject). The macro then put that word in a specific URL and open it in the browser. For e.g. Suppose I get an email and there is a word 'T1234' in the subject or maybe in the body. If I simply select… Read more Âğ
if its in the body, you can definitely do it. Actually, you can do it in the subject too.
The copy to clipboard code here, replying the oMail.Body with Text
Paste clipboard contents using VBA (slipstick.com)
Then build the url - the paste macro on that page shows how. Then send it to the browser (macros on this page.)
This works but you need to copy the (ctrl+c) yourself - then the macro can open the browser to that path
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 OpenLinksCopy()
Dim strURL As String
Dim lSuccess As Long
Dim DataObj As MSForms.DataObject
Dim strPaste 'As Variant
Set DataObj = New MSForms.DataObject
' DataObj.SetText Text
' DataObj.PutInClipboard
DataObj.GetFromClipboard
strPaste = DataObj.GetText(1)
Debug.Print strPaste
strURL = "https://slipstick.me/" & strPaste
Debug.Print strURL
lSuccess = ShellExecute(0, "Open", strURL)
DoEvents
End Sub
Hi everyone,
When the link opens using this code, it automatically opens the save as window. I would like to chose the save as location and file name with this code.
Could you please help me out?
Thank-you in advance
Hi all,
I'am trying to find this link (https://esolutiontecnologia.zendesk.com/expirable_attachments/token/Q2rrZfI0ubBah0fIijBRrAnDr/?name=es-zdyour_unsolved_tickets-view-2020-01-11-1419-csv.zip) under my mail box with the code above (Run a Script Rule).
The browser opens with other links from the message, but that specific link does not comes up...
It could be a problem with .Pattern ?
thanks in advance!
You'll change the pattern -
.Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$%;_])*)>"
Assuming you are always looking for a url containing the words "your_unsolved_tickets"
strURL = M.SubMatches(0)
Debug.Print strURL
If InStr(strURL, "your_unsolved_tickets") = 0 Then GoTo NextURL