Open and Save Hyperlink Files in multiple emails

[yaoxlin]

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]

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:

 

[yaoxlin]

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]

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]

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]

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

 

[misterbobthetomato]

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]

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:

Working with All Items in a Folder or Selected Items

These samples contains the basic code for working with all items in a selected folder or selected items in a folder.

www.slipstick.com

Save as PDF

Save Outlook Email as a PDF

How to use VBA to save selected Outlook messages as PDF files.

www.slipstick.com

Save attachments - if this doesn't have the code to increment the files, i have it somewhere on the site.

Save Attachments to the Hard Drive

The following code saves the attachments from selected messages but does not delete the attachments from the message(s). This VBA code is based on the

www.slipstick.com

 

[misterbobthetomato]

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:

Working with All Items in a Folder or Selected Items

These samples contains the basic code for working with all items in a selected folder or selected items in a folder.

www.slipstick.com

Save as PDF

Save Outlook Email as a PDF

How to use VBA to save selected Outlook messages as PDF files.

www.slipstick.com

Save attachments - if this doesn't have the code to increment the files, i have it somewhere on the site.

Save Attachments to the Hard Drive

The following code saves the attachments from selected messages but does not delete the attachments from the message(s). This VBA code is based on the

www.slipstick.com

So excited to try these. Thank you for helping me to compile to parts.

 

[misterbobthetomato]

Follow-up -
I'm sorry. Where do I make changes within these scripts so that they align with my folders, etc.?