VBA Rule for removing all body but hyperlink then forwarding

Status
Not open for further replies.

Majunga

New Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
I want to create an Outlook rule using a script that will forward an e-mail to my cell phone, keeping the same subject, and removing the majority of the body of the e-mail. The only part of the body I'd like to keep is a hyperlink, and the hyperlink can be listed in two ways: 1) a standard hyperlink (i.e. https://www.google.com) and 2) a hyperlink embedded in text (i.e. Google).

I'm currently using a script that does half of this. It forwards the e-mail but removes the body. It may be easiest just to modify my existing script. Here's the code:
Code:
Public Sub SMS(msg As MailItem)

  Dim olMailFwd As MailItem

  Set olMailFwd = msg.Forward

  With olMailFwd
      .HTMLBody = ""
      .Subject = msg.Subject
      .To = "5551234567@carrier.com" 'enter phone number e-mail address here
  End With

  olMailFwd.Send

  Set olMailFwd = Nothing

End Sub

I tried adapting the code found here under the "Find a code in the message body, then forward" section: Run a Script Rule: Change Subject then Forward Message, but even when I try to use this code unmodified, I get an error saying " Run-time error '5': Invalid procedure call or argument. When I debug, it highlights this line of code:

Item.Subject = M.SubMatches(1) & "; " & Item.Subject
 
Last edited by a moderator:

Majunga

New Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
Sorry about the code tags. Whenever I tried to add them, I received an error.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
there is a bug in a recent forum update - inserting urls only works if http:// is removed - I wasn't aware code tags also failed. :(

This shows how to find links and assign the link to a variable, which you can then insert into the body using .body = strurl.
Open All Hyperlinks in an Outlook Email Message

the macro at Run a Script Rule: Change Subject then Forward Message is similar - you just need the correct pattern and put it in the body, not subject.

I'll have to see if we can pick up hyperlinks using word vba - if so, it would be embedded just as it appears in the email.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
I get an error saying " Run-time error '5': Invalid procedure call or argument. When I debug, it highlights this line of code:

Item.Subject = M.SubMatches(1) & "; " & Item.Subject

it's likely because there is no pattern match. oh, or its because you didn't set a reference to the regex object library.: Microsoft VBScript Regular Expressions 5.5
 

Majunga

New Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
there is a bug in a recent forum update - inserting urls only works if http:// is removed - I wasn't aware code tags also failed. :(

This shows how to find links and assign the link to a variable, which you can then insert into the body using .body = strurl.
Open All Hyperlinks in an Outlook Email Message

the macro at Run a Script Rule: Change Subject then Forward Message is similar - you just need the correct pattern and put it in the body, not subject.

I'll have to see if we can pick up hyperlinks using word vba - if so, it would be embedded just as it appears in the email.

I must have done something wrong. While I'm not getting any errors and the message is forwarding, it is forwarding with a blank body. Here's the code:

Code:
Public Sub SMStest(msg As MailItem)

    Dim olMailFwd As MailItem
    Dim Reg1 As RegExp
    Dim M1 As MatchCollection
    Dim M As Match
    Dim strURL As String
 
Set Reg1 = New RegExp

With Reg1
    .Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$;_])*)>"
    .Global = True
    .IgnoreCase = True
End With

If Reg1.Test(msg.Body) Then

Set M1 = Reg1.Execute(msg.Body)
    For Each M In M1
        strURL = M.SubMatches(0)
        Debug.Print strURL

Next
End If

Set olMailFwd = msg.Forward

   With olMailFwd
       .HTMLBody = stURL
       .Subject = msg.Subject
       .To = "5551234567@carrier.com" 'enter phone number e-mail address here
   End With

olMailFwd.Send

Set olMailFwd = Nothing
Set Reg1 = Nothing


End Sub
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
I'm not going to comment on how long it took me to see the problem... :) but
.HTMLBody = stURL is spelled wrong, it should be strURL.

you might need to use .Body = strURL if its not clickable.

The code gets the last url - to get the first, use
.Global = False
 

Majunga

New Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
Yup, I ended up writing the script over again and realized that was the problem after I mistakenly typed it wrong a second time.

So, it's working now that I've made that correction. How difficult do you think it would be to modify it further so that it can pull multiple hyperlinks from the e-mail instead of just one, and send those hyperlinks in one single forward?
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
This variation gets the last link and pastes it as formatted text (embedded link)
Code:
Dim olMailFwd As MailItem
Dim objInsp As Outlook.Inspector
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objSel As Word.Selection
On Error Resume Next

Set olMailFwd = msg.Forward

With olMailFwd
.Subject = msg.Subject
.To = "5551234567@carrier.com" 'enter phone number e-mail address here
End With
Set objInsp = olMailFwd.GetInspector
If objInsp.EditorType = olEditorWord Then
Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
Set objSel = objWord.Selection
With objSel
.WholeStory

Dim H As Word.Hyperlink
For Each H In objDoc.Hyperlinks
H.Range.Select
.Copy
Next H
End With
End If
olMailFwd.Body = ""

objSel.PasteAndFormat (wdFormatOriginalFormatting)

olMailFwd.Display

Set olMailFwd = Nothing

End Sub
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
BTW, to test the code (or any run a script code) without sending messages, you can use this stub - select a message then run this code to call the macro.

Code:
Sub RunScript()
Dim objApp As Outlook.Application
Dim objItem As MailItem
Set objApp = Application
Set objItem = objApp.ActiveExplorer.Selection.Item(1)

'macro name you want to run goes here
SMStest objItem

End Sub


Also, because the macro in the message above doesn't check for http, it gets the last link, which could be a mailto.

You can use something like this to filter for a word in the address -
If InStr(lcase(H.Address), "word") <> 0 Then
.copy
end if
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
How difficult do you think it would be to modify it further so that it can pull multiple hyperlinks from the e-mail instead of just one, and send those hyperlinks in one single forward?

Not hard - you just need to tweak it - with the strURL code, do something like
strURL = strURL & vbcrlf & M.SubMatches(0)

The word code sample is a little more difficult - you need to scan the original message and write he links as you go.
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
diver864 vba for a rule to automatically accept meeting requests with 'vacation' in subject, change to all-day event, change to free, don't send reply Outlook VBA and Custom Forms 1
N Outlook Email Rule execution through shortcut keys (VBA codes) Using Outlook 1
dweller Outlook 2010 Rule Ignores VBA Script Outlook VBA and Custom Forms 2
K VBA BeforeItemMove event create rule to always move to its folder. Outlook VBA and Custom Forms 4
O VBA rule on multiple computers using shared mailbox Outlook VBA and Custom Forms 1
O modify vba to run it as script rule Outlook VBA and Custom Forms 8
I shared mailbox - can i create a rule (vba) for every user? Outlook VBA and Custom Forms 1
G VBA code to enable a rule based on time of day for a IMAP mail account Outlook VBA and Custom Forms 14
Gary Brown Outlook 2013 VBA to run a rule Outlook VBA and Custom Forms 13
N VBA, Rule that will Auto Reply based on time of day Outlook VBA and Custom Forms 1
C Further automate several tasks with rule, VBA or Quick Step Using Outlook 1
S Outlook VBA rule script to process both MailItem and MeetingItem Using Outlook 0
D Update existing rule using VBA Using Outlook 2
R vba rule exception "except with specific words in the sender's add Outlook VBA and Custom Forms 2
R Outlook 2003/2007 Rule and Conditions for InBox VBA customization Outlook VBA and Custom Forms 3
K Re: Cuestom outlook rule using vba Outlook VBA and Custom Forms 4
D VBA code to select a signature from the signatures list Outlook VBA and Custom Forms 3
D Create advanced search (email) via VBA with LONG QUERY (>1024 char) Outlook VBA and Custom Forms 2
David McKay VBA to manually forward using odd options Outlook VBA and Custom Forms 1
FryW Need help modifying a VBA script for in coming emails to auto set custom reminder time Outlook VBA and Custom Forms 0
S vba outlook search string with special characters Outlook VBA and Custom Forms 1
S VBA 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
DDB VBA to Auto Insert Date and Time in the signature Outlook VBA and Custom Forms 2
F VBA to move email from Non Default folder to Sub folders as per details given in excel file Outlook VBA and Custom Forms 11
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
B Zoom automatically next email item (VBA) Outlook VBA and Custom Forms 2
T vba extract data from msg file as attachment file of mail message Outlook VBA and Custom Forms 1
K Outlook Office 365 VBA download attachment Outlook VBA and Custom Forms 2
A VBA Script - Print Date between first email in Category X and last email in Category Y Outlook VBA and Custom Forms 3
N Help creating a VBA macro with conditional formatting to change the font color of all external emails to red Outlook VBA and Custom Forms 5
N Save selected messages VBA does not save replies and/or messages that contain : in subject Outlook VBA and Custom Forms 1
Y Filter unread emails in a search folder vba help Outlook VBA and Custom Forms 0
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
L Modifying VBA script to delay running macro Outlook VBA and Custom Forms 3
L Need help modifying a VBA script for emails stuck in Outbox Outlook VBA and Custom Forms 6
K can't get custom form to update multiple contacts using VBA 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
S Add VBA save code Using Outlook 0
C Auto Run VBA Code on new email Outlook VBA and Custom Forms 1
O VBA Cases with Listbox - Can you use Multi-Select? Outlook VBA and Custom Forms 4
O VBA Outlook Message Attachment - Array Index Out of Bounds Outlook VBA and Custom Forms 0
V Modifying the built in forms with VBA Outlook VBA and Custom Forms 4
S Excel VBA and shared calendar issue Outlook VBA and Custom Forms 3
L Macro/VBA to Reply All, with the original attachments Outlook VBA and Custom Forms 3

Similar threads

Top