Opening a link from a specific sender automatically

[aniaaneczka]

Operating system::    Windows 10
Outlook version:     classic Outlook
Email type or host:    Microsoft 365

---

Hi,

I need to have a link from a specific sender open automatically in Firefox when the email is received.
This is the macro I am testing. It is probably a mess.
I get a Compile error with "unexpected identifier" pointing to the line Sub OpenLinksMessage().

Can anyone tell me how to get the macro work?

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


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.Firefox().Selection(1)

Set Reg1 = New RegExp

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

if item.senderemailaddress = "someone@something.com" 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

End if

Set Reg1 = Nothing
End Sub

 

[Diane Poremsky]

It is working here - are you using 32 or 64 bit windows and outlook?

 

[aniaaneczka]

Hi Diane, I use 64 bit windows and outlook. Unfortunately, it only works in the Visual Basic editor, but not in my Outlook, where I created a rule: when a message with a specific text in the title arrives, the script should be executed. This is the VB script I'm using:


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 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 ("C:\Program Files\Google\Chrome\Application\chrome.exe" & " -url " & strURL)
DoEvents

NextURL:
Next
End If

Set Reg1 = Nothing
End Sub

 

[Diane Poremsky]

That is not going to work in a rule -
Public Sub OpenLinksMessage()

needs to be something like Public Sub OpenLinksMessage(olMail as mailitem) - and the set olMail line removed.

these is an example here - there is one a bit under the first run a script macro for Run a script version for Chrome

Open Hyperlinks in an Outlook Email Message (slipstick.com)

 

[aniaaneczka]

That is not going to work in a rule -
Public Sub OpenLinksMessage()

needs to be something like Public Sub OpenLinksMessage(olMail as mailitem) - and the set olMail line removed.

these is an example here - there is one a bit under the first run a script macro for Run a script version for Chrome

Open Hyperlinks in an Outlook Email Message (slipstick.com)

This worked, thank you!