How to open a specific link automatically with outlook

Status
Not open for further replies.

amandajeanthomson

New Member
Outlook version
Outlook 2016 64 bit
Email Account
POP3
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, "twitter.com") Then GoTo NextURL
If InStr(strURL, "linkedin.com") Then GoTo NextURL

If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)

Shell (browserPath & " -url " & strURL)
DoEvents

NextURL:
Next
End If

End With
Next
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

Amanda
 
Amanda, I am trying to accomplish something the same as you. Did you ever find a solution?
Thanks,
Keogh
 
This should work... it skips the url if a match is found, if no match, it moves to the next if.
Code:
If InStr(strURL, "unsubscribe") Then GoTo NextURL
If InStr(strURL, "reject") Then GoTo NextURL
If InStr(strURL, "newsletter") Then GoTo NextURL
If InStr(strURL, "twitter.com") Then GoTo NextURL
If InStr(strURL, "linkedin.com") Then GoTo NextURL
If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)

The big thing to verify is if the url contains the words… Debug.Print strURL prints the url to the immediate window but to might be easier during testing to use msgbox strurl so you can see on screen what the url is before it goes though the if's - strURL is just the url, not the display name.


for example, the first one would be picked up by the if statement and skipped but the facebook url would get past the if statement.
HTML:
<a href="https://twitter.com">twitter.com</a>
 <a href="https://list.slipstick.com/l/facebook">facebook.com</a>
 
Oh, I see. So even if the hyperlink is attached to the anchored text, it "prints" it out and verifies that the text is actually in the URL? That correct? I will try it out.
How would I get it to kick off ONLY from a specific sender?
Cheers!
Keogh
 
Unfortunately, for me, there is no key word in the actual URL that can be used. It is a random string. I need to be able to key on the text the the hyperlink is anchored to.
Diane, I replied in another thread you were on regarding this also. Any ideas?
Automatically open link in email received
Much appreciation.
 
correct - the macro only check for the word or phrase in the url, not the anchored text.

Unfortunately, for me, there is no key word in the actual URL that can be used. It is a random string. I need to be able to key on the text the the hyperlink is anchored to.
Hmmm. if the pattern looks for <a... </a> it picks up...
HTML:
<a href="https://list.slipstick.com/l/facebook">facebook.com</a>
and if no matches, a submatch holds the actual url

I didn't test this, so the pattern might not be right but the basic premise should be good - i think this is mostly correct to get the url if there are css directives in the a tag.

Code:
With olMail
With Reg1
.Pattern = "(<a\s*(.*)(https?[:]//([0-9a-z=\?:/\.&-^!#$;_])*\s*(.*))</a>)"
.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)
openURL =M.SubMatches(2)
Debug.Print strURL
Debug.Print openURL

If InStr(strURL, "unsubscribe") Then GoTo NextURL
If InStr(strURL, "reject") Then GoTo NextURL
If InStr(strURL, "newsletter") Then GoTo NextURL
If InStr(strURL, "twitter.com") Then GoTo NextURL
If InStr(strURL, "linkedin.com") Then GoTo NextURL
If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)

Shell (browserPath & " -url " & openURL )
 
correct - the macro only check for the word or phrase in the url, not the anchored text.


Hmmm. if the pattern looks for <a... </a> it picks up...
HTML:
<a href="https://list.slipstick.com/l/facebook">facebook.com</a>
and if no matches, a submatch holds the actual url

I didn't test this, so the pattern might not be right but the basic premise should be good - i think this is mostly correct to get the url if there are css directives in the a tag.

Code:
With olMail
With Reg1
.Pattern = "(<a\s*(.*)(https?[:]//([0-9a-z=\?:/\.&-^!#$;_])*\s*(.*))</a>)"
.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)
openURL =M.SubMatches(2)
Debug.Print strURL
Debug.Print openURL

If InStr(strURL, "unsubscribe") Then GoTo NextURL
If InStr(strURL, "reject") Then GoTo NextURL
If InStr(strURL, "newsletter") Then GoTo NextURL
If InStr(strURL, "twitter.com") Then GoTo NextURL
If InStr(strURL, "linkedin.com") Then GoTo NextURL
If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)

Shell (browserPath & " -url " & openURL )

Thank you so much. I think I can get it to work. I think I found something unique in the URL I can match to.
Last thing, how can I get it to process new emails in the inbox from a specific email address? I apologize if my terminology is incorrect.
 
if you were using a run a script version, you'd set up the rule to look for that address... in an itemadd, you need to use an if statement.

if item.senderemailaddress = "someone@domain.com" then
'the code goes here
end if

As an FYI, the macro above as written looks like a run a script, but it is not correct - you won't use this in a run a script (or item add macro) For Each olMail In objItems
That line will cause the macro to check every message in the folder, not just the new one.

it should work to replace these two lines and remove the very last Next

For Each olMail In objItems
With olMail


with

with item
 
Below is what I have. It builds off of your first example on Open All Hyperlinks in an Outlook Email Message.
What changes would I make to this to trigger on ONLY new mail arriving in the inbox? I have an outlook rule to only call the script when sent by a specific email address.

Sub OpenLinksMessage(Item As Outlook.MailItem)
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, "@") Then GoTo NextURL
If InStr(strURL, "test") Then GoTo NextURL
If InStr(strURL, "test2") 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
 
Remove this - it tells the macro to use the selected item.
Set olMail = Application.ActiveExplorer().Selection(1)

Then change all instances of olMail to Item (or change Item in (Item As Outlook.MailItem) to olMail)

The macro sample at this bookmark Open All Hyperlinks in an Outlook Email Message will work with a rule.
 
Remove this - it tells the macro to use the selected item.
Set olMail = Application.ActiveExplorer().Selection(1)

Then change all instances of olMail to Item (or change Item in (Item As Outlook.MailItem) to olMail)

The macro sample at this bookmark Open All Hyperlinks in an Outlook Email Message will work with a rule.

Diane, thank you so much for your assistance. You are a gem. I think I actually got it to function, however Safe Links is somehow disallowing the launch of the allowed URL even though you can manually click on the URL and it launches fine. Anywhere online I can buy you a beer?
Cheers!
Keogh
 
I think I may have figured out where the issue is. I hope. Safe Links prepends every URL with "Office365". Everything after the percent sign (including the percent sign) is chopped off of the URL when it is opened in Internet Explorer. I attempted to edit the Reg1 .Pattern to look like below, adding the %, however it is still not seeing the "%". I tried with brackets ([%]) around it also to no avail. Any ideas?

.Pattern = "(https?[:]//%([0-9a-z=\?:/\.&-^!#$;_])*)"
 
I think I may have figured out where the issue is. I hope. Safe Links prepends every URL with "Office365". Everything after the percent sign (including the percent sign) is chopped off of the URL when it is opened in Internet Explorer. I attempted to edit the Reg1 .Pattern to look like below, adding the %, however it is still not seeing the "%". I tried with brackets ([%]) around it also to no avail. Any ideas?

.Pattern = "(https?[:]//%([0-9a-z=\?:/\.&-^!#$;_])*)"
Fixed it. Added the "%" towards the end.

.Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$%;_])*)"
 
Anyone else that wants a "run a script" macro to run when new email arrives, the code is below. I have added a timer in case you want to wait a while before opening the URLs. Thanks to Diane for your template and assistance.

Public Sub OpenLinksMessage(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 Reg1 = New RegExp

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

'Wait for a certain amount of time before opening URLs.
tTime0 = Now
Do Until tTime0 + TimeValue("00:00:53") < Now
DoEvents
Loop

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, "@") Then GoTo NextURL 'Ignore emails.
If InStr(strURL, "unsubscribe") Then GoTo NextURL 'Ignore specific string in URL.
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
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
A How to open a specific link automatically with outlook 2016 Outlook VBA and Custom Forms 6
L Macro to Open a Specific Word Document - Outlook 2007 Using Outlook 17
C Want to Create Shortcut to Open Specific Calendars at the Same Time Using Outlook 2
X open specific e-mail messages in outlook 2007 c# Outlook VBA and Custom Forms 1
G Get current open draft message body from VBA Outlook VBA and Custom Forms 1
Rupert Dragwater How to get Outlook 365 to open from websites Using Outlook 5
Witzker Outlook 2019 Edit contact from email does not open the user defined contactform Using Outlook 3
S Leaving ActiveExplorer open for editing after Sub is done Outlook VBA and Custom Forms 0
Commodore PDF attachments started to open in Edge Using Outlook 0
T Outlook 2021 Cannot open attachments Outlook DeskTop 2021 Using Outlook 0
X Open Hyperlinks in an Outlook Email Message (Help with Diane's solution) Outlook VBA and Custom Forms 3
S HTML Code Embedded in String Within Open Outlook Email Preventing Replace(Application.ActiveInspector.CurrentItem.HTMLBody From Working Outlook VBA and Custom Forms 4
talla Can't open Outlook Item. Using Outlook 0
O Outlook on Android: after sharing / sending a news article, draft remains open. Why? Using Outlook 1
K Embedded photos no longer open with Photos or Photo Viewer Using Outlook 7
Witzker Open Contact missing in Outlook 2019 Using Outlook 2
L Cannot open PST file for first session each day Using Outlook 6
H Upon opening Outlook, make my popmail inbox open instead of outlook.com inbox Using Outlook 1
sahameed82 SharePoint calendar directly open in Outlook Using Outlook 0
N .pst archive from work will not open/import on Microsoft 365 Exchange Server Administration 0
C Outlook 2016/2019 hangs after being open for an extended period Using Outlook 4
M Where is the setting to *turn off* open calendar in a new window? Using Outlook 3
W Automatically open attachments without automatically printing them Using Outlook 0
Y Open and Save Hyperlink Files in multiple emails Outlook VBA and Custom Forms 9
J How to open OST file in Outlook 2019 & 2016 Using Outlook 1
C Can't Open Outlook 365 Using Outlook 0
D after delete mail, open the next one Outlook VBA and Custom Forms 0
N VBA Script to Open highlighted e-mail and Edit Message Outlook VBA and Custom Forms 5
M outlook won't open! Using Outlook 1
N Open & Save VBAProject.Otm using VBA Code Outlook VBA and Custom Forms 1
E Unable to open Outlook 2010 after adding new email account Using Outlook 4
M other user's mailbox won't open, forms disappeared Using Outlook 42
S SendFromAccount - Problem trying to test existing value in open email Outlook VBA and Custom Forms 2
J Open an outlook email by Subject on MS Access linked table with VBA Outlook VBA and Custom Forms 10
D Add Tetxbox at form open Outlook VBA and Custom Forms 1
U Catching ModuleSwitch events after "open in new window" Outlook VBA and Custom Forms 2
Andrew Quirl Open attachment, manipulate without add-on program? Outlook VBA and Custom Forms 5
S Reminder Dialog Open Button Using Outlook 2
S Outlook 2010 Cannot Open Attachments Using Outlook 14
N open the hyperlink in Outlook directly instead of browser Using Outlook 1
S Outlook does not open the .pst file created by the Outlook Using Outlook 5
A open Outlook with multiple windows. Using Outlook 0
K open calendar from address book Outlook VBA and Custom Forms 1
T Double clik behavior on agenda open a new meeting request Using Outlook 1
E Open olNoteItem Attachment Outlook VBA and Custom Forms 6
G Can't open .pst. Message could not access default folder (Outlook 2010 (.pst). Before that was backi Using Outlook 0
I Outlook 2010, 2013 will not open .msg or .eml files Using Outlook.com accounts in Outlook 1
Diane Poremsky Outlook VBA: Work with Open Item or Selected Item Using Outlook 0
O Windows 10 x64 Outlook 2013 - URL does not open (anymore) Using Outlook 3
Hudas VBA find and open an email without looping thru each email in the inbox Outlook VBA and Custom Forms 1

Similar threads

Back
Top