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
 
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
Good morning.

My answer might be hiding inside the above options. I am just not seeing it, unfortunately. Let me explain what I'm seeking and ask that you point me in the right direction.

Thank you so much...really appreciate it!


Bob

I run Google Chrome with my Outlook 2013 64-bit.
The initial goal is to manually run a single script (VBA or other from the toolbar/ribbon) on a single email:

  1. Save Email Message itself (any format that makes sense...preference being .pdf).
  2. Save Linked Documents from Email Body - typically more than one with different files names.
  3. Avoid Saving Unwanted Links from Email Body (there is an image and a link to a .pdf handbook within each email).
  4. All of these items to be saved within a one folder per email.
  5. Folder to be named with the Subject Line.
  6. Items inside the folder to be named with the Subject Line at the front or the rear of the new file name.
  7. Save identically-named files and/or folders with an added marker (presumably, a (1), (2), etc.).
  8. Nothing opens by itself. I will open the documents manually at a later time for manipulation and printing.
  9. If it makes a difference to your planning, once this script functions, I would like to be able to run this script on multiple (manually-selected) files. To be clear, not an entire folder.

 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
All but #3 are fairly simple and I have macros that do all of them, mostly in separate macros, so they need to be put together.

#3 is the bug-a-boo. If the links are always in the signature, it might be easier, but that can be hit or miss. The message could be saved as plain text - but this removes all images and hyperlinks, not just the 'unwanted links'

Working with selected items:

Save as PDF

Save attachments - if this doesn't have the code to increment the files, i have it somewhere on the site.
 
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
All but #3 are fairly simple and I have macros that do all of them, mostly in separate macros, so they need to be put together.

#3 is the bug-a-boo. If the links are always in the signature, it might be easier, but that can be hit or miss. The message could be saved as plain text - but this removes all images and hyperlinks, not just the 'unwanted links'

Working with selected items:

Save as PDF

Save attachments - if this doesn't have the code to increment the files, i have it somewhere on the site.
So excited to try these. Thank you for helping me to compile to parts.
 
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
Follow-up -
I'm sorry. Where do I make changes within these scripts so that they align with my folders, etc.?
 
Top