Open and Save Hyperlink Files in multiple emails

yaoxlin

Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
Hi, I'm very new to this VBA but have read Open All Hyperlinks in an Outlook Email Message posting. However, I'm looking for a way to open a very specific Hyperlink within an email usually following the word "Attachments" the name of the Hyberlinks differ each time. Or perhaps another way to go about is is to remove the other hyperlinks that don't pertain to the one I want by using this...
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
But I haven't been successful in removing the unwanted links

any help is much appreciated. Thanks!
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
The hyperlink url does not contain the word 'attachment' but the its in the message body?

This should do it, where "View this thread" is the pretty part of the hyperlink. It's under Open a specific hyperlink

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

That code would open the link in this email message:
2747
 

yaoxlin

Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
My emails work the opposite... where I have 5-7 hyperlinks with names that doesn't change... but the attachment I want changes names ak the time.
 

yaoxlin

Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
What if I change the global = false for this that are always the same name per email. That should only open the ones that are not " view this thread"
 

yaoxlin

Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
Here is what I have:

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=\?:/\.&-^!#$%;_])*)"
.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)

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

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

With Reg1
.Pattern = "this short training video <(.*)>"
.Global = False
.IgnoreCase = True
End With

With Reg1
.Pattern = "support@procore.com <(.*)>"
.Global = False
.IgnoreCase = True
End With

With Reg1
.Pattern = "Support Home <(.*)>"
.Global = False
.IgnoreCase = True
End With
 

yaoxlin

Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
that didn't work...

I'm trying this but it's not working either.


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=\?:/\.&-^!#$%;_])*)"
.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)

If InStr(strURL, "View online") 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

If InStr(strURL, "View PDF") 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

If InStr(strURL, "this short training video.") 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

If InStr(strURL, "Procore") 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

If InStr(strURL, "support@procore.com") 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

If InStr(strURL, "https://suport.procore.com") 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
 
Top