Extract all links from Outlook email, send to Excel

mylon

New Member
Outlook version
Outlook 2013 64 bit
Email Account
IMAP
Hi all,

I'm new to VBA coding so hoping you can help.

I'm trying to come up with a VBA and script that will look for all new emails that are coming from a particular email address to automatically extract all hyperlinks (whether naked URLs or links with anchors) and send them over to an Excel file. It should disregard the URLs of any png/jpg images.

I'm hoping to send all hyperlinks, along with the Subject line, the date/time, anchor text.. all in their respective columns inside just one Excel file.
So whenever an email is received it will add to the existing data in the Excel file.

Is this something that can be done?

Really appreciate your help.

Thank you.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
It is doable. This article shows how to get the links out - i don't have any samples that write them to a file, but have other samples that write to Excel on my site.

 

mylon

New Member
Outlook version
Outlook 2013 64 bit
Email Account
IMAP
Hi Diane, thank you for the link and your thoughts.

So far using the below code I managed to create a rule for each new email that is delivered to open all hyperlinks in my browser (Firefox).

Almost everything is working well, except that it clicks on the Unsubscribe link as well - even though it's supposed to skip those.

Code:
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)\Mozilla Firefox\firefox.exe" & Chr(34)
 
Set Reg1 = New RegExp

With Reg1
 .Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$%;_])*)"
' opens all links, false to open first
 .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)

' skips links containing the word 'unsubscribe'
If InStr(strURL, "unsubscribe") Then GoTo NextURL

' skips links that are .png images'
If InStr(strURL, ".png") Then GoTo NextURL

' skips links that are .png images'
If InStr(strURL, ".jpg") Then GoTo NextURL

' skips links that are .png images'
If InStr(strURL, ".jpeg") 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

So, I'm fine with opening the links in browser.
Additionally, I'd like to take all those links and write them in an Excel file.

I found this post on Reddit where it explains: How to parse an Outlook email using vba in Excel

I'm just not sure how to modify the code to fit my use case: 1) Open all hyperlinks in Firefox, except the unsubscribe link, and 2) Write all hyperlinks from all new emails in one pre-defined Excel file.

Any help would be super appreciated.
 
Top