Outlook 365 Outlook/VBA

Status
Not open for further replies.
E

eflats

New Member
Outlook version
Outlook 2016 64 bit
Email Account
IMAP
Hi I am fairly new to VBA and using it in outlook. Found this tutorial but cant seem to isolate the link I want to click in the email. Please help
www.slipstick.com

Open Hyperlinks in an Outlook Email Message

Use an Outlook macro to open every hyperlink in the selected email message or open hyperlinks in every message in the selected folder.
www.slipstick.com www.slipstick.com
 
Diane Poremsky said:
get the message source, put it in a text file and post it in this thread - I'll take a look.
Click to expand...
I basically am using code I found on here. I mean it works and ive added some ignore lines like I saw you post. But I feel like there has to be a way to isolate the link since every single email I get is the same with an accept button then it opens a page with further options I would love to have an automatic interaction take place once the new tab opens. Also is there a way to have this script scan all inboxes and play once email is received not opened?

Here is the link from the email less the unique identifiers....
choicehomewarranty.com/cads/accept.php?


Code: 
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.ActiveExplorer().Selection(1)
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)
    Debug.Print strURL
   If InStr(strURL, "unsubscribe") Then GoTo NextURL
   If InStr(strURL, "http://www.choicehomewarranty.com/cads/images/logo.png") Then GoTo NextURL
   If InStr(strURL, "http://www.choicehomewarranty.com/cads/images/wo.png") Then GoTo NextURL
   If InStr(strURL, "https://my.choicehomewarranty.com/images/spacer.png") Then GoTo NextURL
   If InStr(strURL, "http://www.choicehomewarranty.com/cads/images/checkmark2.jpg") Then GoTo NextURL
   If InStr(strURL, "http://www.choicehomewarranty.com/cads/images/xmark2.jpg") Then GoTo NextURL
   If InStr(strURL, "http://www.choicehomewarranty.com/cads/decline.php*") Then GoTo NextURL
If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)
   lSuccess = ShellExecute(0, "Open", strURL)

  DoEvents
NextURL:
  Next
  End If
Set Reg1 = Nothing
 End Sub
 
Last edited by a moderator:
These lines
If InStr(strURL, "http://www.choicehomewarranty.com/cads/images/xmark2.jpg") Then GoTo NextURL

could be condensed to one line -
If InStr(strURL, "http://www.choicehomewarranty.com/cads/images/") Then GoTo NextURL

or even something like this:
If InStr(strURL, "cads/images/") Then GoTo NextURL


What does the debug.print strurl show for the urls? Show the immediate window to view - or after the If Right(strURL, 1) = line, add msgbox strurl to display it in a message box before opening it. That way you can see if it is properly formed.

another option is to use something like this instead of listing all the lines.
If InStr(strURL, "SWO Accept") Then
msgbox strurl ' during testing, to verify the link looks good
lSuccess = ShellExecute(0, "Open", strURL)
end If
 
Diane Poremsky said:
These lines
If InStr(strURL, "http://www.choicehomewarranty.com/cads/images/xmark2.jpg") Then GoTo NextURL

could be condensed to one line -
If InStr(strURL, "http://www.choicehomewarranty.com/cads/images/") Then GoTo NextURL

or even something like this:
If InStr(strURL, "cads/images/") Then GoTo NextURL


What does the debug.print strurl show for the urls? Show the immediate window to view - or after the If Right(strURL, 1) = line, add msgbox strurl to display it in a message box before opening it. That way you can see if it is properly formed.

another option is to use something like this instead of listing all the lines.
If InStr(strURL, "SWO Accept") Then
msgbox strurl ' during testing, to verify the link looks good
lSuccess = ShellExecute(0, "Open", strURL)
end If
Click to expand...
Can you show me what you mean? I tried to enter that bit of code where I thought it belonged but it did nothing for me. Also maybe show where debug.print would go to verify the info you are looking for?
 
This should work - you only need one of the strURL blocks - should be able to test it with both blocks to verify each works as expected. If there is only one url to open, you can exit the sub when found

Code: 
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.ActiveExplorer().Selection(1)

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)
Debug.Print strURL

' Either this block
If InStr(strURL, "unsubscribe") Then GoTo NextURL
If InStr(strURL, "cads/images/") Then GoTo NextURL
If InStr(strURL, "http://www.choicehomewarranty.com/cads/decline.php*") Then GoTo NextURL
If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)
msgbox strurl ' during testing, to verify the link looks good
Debug.Print strURL
lSuccess = ShellExecute(0, "Open", strURL)
'end block

' or this block should work
If InStr(strURL, "http://www.choicehomewarranty.com/cads/accept.php") Then
msgbox strurl ' during testing, to verify the link looks good
Debug.Print strURL
lSuccess = ShellExecute(0, "Open", strURL)
exit sub ' if there is only one link yo open, exit sub once its found
end If
' end block


DoEvents

NextURL:
Next
End If

Set Reg1 = Nothing
End Sub
 
Diane Poremsky said:
This should work - you only need one of the strURL blocks - should be able to test it with both blocks to verify each works as expected. If there is only one url to open, you can exit the sub when found

Code: 
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.ActiveExplorer().Selection(1)

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)
Debug.Print strURL

' Either this block
If InStr(strURL, "unsubscribe") Then GoTo NextURL
If InStr(strURL, "cads/images/") Then GoTo NextURL
If InStr(strURL, "http://www.choicehomewarranty.com/cads/decline.php*") Then GoTo NextURL
If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)
msgbox strurl ' during testing, to verify the link looks good
Debug.Print strURL
lSuccess = ShellExecute(0, "Open", strURL)
'end block

' or this block should work
If InStr(strURL, "http://www.choicehomewarranty.com/cads/accept.php") Then
msgbox strurl ' during testing, to verify the link looks good
Debug.Print strURL
lSuccess = ShellExecute(0, "Open", strURL)
exit sub ' if there is only one link yo open, exit sub once its found
end If
' end block


DoEvents

NextURL:
Next
End If

Set Reg1 = Nothing
End Sub
Click to expand...
Very cool so it makes me accept via a popup. Can be handy. My end goal is for this to run immediately once an email is received. Then further accept and schedule from a radio button selection in the new browser tab.

So with this code I get three popups all of which I have to ok before the tab opens first one is not relevant. Its https://my.choicehomewarranty.com/images/spacer.png then the second two are the outcome of clicking on accept and are identical.
 
eflats said:
Very cool so it makes me accept via a popup. Can be handy. My end goal is for this to run immediately once an email is received. Then further accept and schedule from a radio button selection in the new browser tab.

So with this code I get three popups all of which I have to ok before the tab opens first one is not relevant. Its https://my.choicehomewarranty.com/images/spacer.png then the second two are the outcome of clicking on accept and are identical.
Click to expand...
I was hoping all this would fully automate
 
eflats said:
o with this code I get three popups all of which I have to ok before the tab opens first one is not relevant. Its https://my.choicehomewarranty.com/images/spacer.png then the second two are the outcome of clicking on accept and are identical.
Click to expand...
The msgbox are just for testing- comment out or remove those lines, like this:

' msgbox strurl ' during testing, to verify the link looks good
 
Is the url in twice?

it will ask twice in the either or blocks - but the second one exists when a match is found.
' Either this block
' or this block should work

try removing the first block and see if it only comes up once. If so, that is the one you want to use.
 
Status
Not open for further replies.
< VBA Macro to Print and Save email to network location | Small vba to kill political email >
Similar threads
Thread starter Title Forum Replies Date
C VBA in "New Outlook?" Using Outlook 0
efire9207 VBA Outlook Contacts Outlook VBA and Custom Forms 6
B Requesting VBA code to make Outlook prompt for confirmation when deleting a task? Outlook VBA and Custom Forms 4
J Outlook VBA to send from Non-default Account & Data Files Outlook VBA and Custom Forms 4
P VBA to add email address to Outlook 365 rule Outlook VBA and Custom Forms 0
M Outlook 2016 outlook vba to look into shared mailbox Outlook VBA and Custom Forms 0
D Outlook VBA forward the selected email to the original sender’s email ID (including the email used in TO, CC Field) from the email chain Outlook VBA and Custom Forms 2
L Fetch, edit and forward an email with VBA outlook Outlook VBA and Custom Forms 2
BartH VBA no longer working in Outlook Outlook VBA and Custom Forms 1
W Can vba(for outlook) do these 2 things or not? Outlook VBA and Custom Forms 2
richardwing Outlook 365 VBA to access "Other Actions" menu for incoming emails in outlook Outlook VBA and Custom Forms 0
J Outlook Rules VBA Run a Script - Multiple Rules Outlook VBA and Custom Forms 0
C Outlook (desktop app for Microsoft365) restarts every time I save my VBA? Using Outlook 1
J VBA for outlook to compare and sync between calendar Outlook VBA and Custom Forms 1
E Outlook VBA change GetDefaultFolder dynamically Outlook VBA and Custom Forms 6
S vba outlook search string with special characters Outlook VBA and Custom Forms 1
U Outlook 2019 VBA run-time error 424 Outlook VBA and Custom Forms 2
G VBA to save selected Outlook msg with new name in selected network Windows folder Outlook VBA and Custom Forms 1
F Excel VBA to move mails for outlook 365 on secondary mail account Outlook VBA and Custom Forms 1
K Outlook Office 365 VBA download attachment Outlook VBA and Custom Forms 2
V vBA for searching a cell's contents in Outlook and retrieving the subject line Outlook VBA and Custom Forms 1
B vBA for exporting excel file from outlook 2016 Outlook VBA and Custom Forms 3
S Excel vba code to manage outlook web app Using Outlook 10
H Custom Outlook Contact Form VBA Outlook VBA and Custom Forms 1
S Problem Checking the available stores in my Inbox (Outlook VBA) Outlook VBA and Custom Forms 0
S Outlook VBA How to adapt this code for using in a different Mail Inbox Outlook VBA and Custom Forms 0
O VBA Outlook Message Attachment - Array Index Out of Bounds Outlook VBA and Custom Forms 0
J Want to learn VBA Macros for Outlook. What book can you recommend? Outlook VBA and Custom Forms 1
M Outlook 2013 reminder email by using Outlook vba Outlook VBA and Custom Forms 2
D Outlook VBA error extracting property data from GetRules collection Outlook VBA and Custom Forms 10
O Email not leaving Outbox when using Excel VBA to sync Outlook account Outlook VBA and Custom Forms 4
L Moving emails with similar subject and find the timings between the emails using outlook VBA macro Outlook VBA and Custom Forms 1
B Outlook Business Contact Manager with SQL to Excel, User Defined Fields in BCM don't sync in SQL. Can I use VBA code to copy 1 field to another? BCM (Business Contact Manager) 0
N How can I increase/faster outlook VBA Macro Speed ? Using Outlook 2
N Outlook Email Rule execution through shortcut keys (VBA codes) Using Outlook 1
A VBA Code in Outlook disappears after first use Outlook VBA and Custom Forms 1
dweller Outlook 2010 Rule Ignores VBA Script Outlook VBA and Custom Forms 2
G Outlook VBA and Google Calendar ("Events") Outlook VBA and Custom Forms 1
J VBA Outlook : Subject line : Cut and Paste name to heading , number to very end of the body of Email Outlook VBA and Custom Forms 1
B Advanced Search in MS Outlook by VBA and SQL Outlook VBA and Custom Forms 2
K Outlook Archive to PST Files by Date Range VBA Script? Outlook VBA and Custom Forms 1
J Help Please!!! Outlook 2016 - VBA Macro for replying with attachment in meeting invite Outlook VBA and Custom Forms 9
S Find a cell value in excel using outlook vba Using Outlook 1
J Execute Add-In Button from VBA Outlook 2016 Outlook VBA and Custom Forms 1
J Open an outlook email by Subject on MS Access linked table with VBA Outlook VBA and Custom Forms 10
D create an html table in outlook custom form 2010 using vba in MsAccess Outlook VBA and Custom Forms 7
M Slow VBA macro in Outlook Outlook VBA and Custom Forms 5
T Outlook AntiSpam with VBA Outlook VBA and Custom Forms 1
F "Move to" O365 feature to Outlook client via VBA Outlook VBA and Custom Forms 4
B query outlook using vba Outlook VBA and Custom Forms 13

Similar threads

Back
Top