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:
Sorry about the code tags. Whenever I tried to add them, I received an error.
 
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 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
 
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
 
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
 
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?
 
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
 
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
 
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
P VBA to add email address to Outlook 365 rule Outlook VBA and Custom Forms 0
B Modify VBA to create a RULE to block multiple messages Outlook VBA and Custom Forms 0
D VBA - unable to set rule condition 'on this computer only' Outlook VBA and Custom Forms 5
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
M Outlook 365 VBA Auto-Forward Only the first of Duplicate Emails Outlook VBA and Custom Forms 2
N VBA Code Not Working correctly Outlook VBA and Custom Forms 1
L VBA to Triage Incoming Email Outlook VBA and Custom Forms 0
J Outlook VBA to send from Non-default Account & Data Files Outlook VBA and Custom Forms 3
H using VBA to edit subject line Outlook VBA and Custom Forms 0
G Get current open draft message body from VBA Outlook VBA and Custom Forms 1
Geldner Problem submitting SPAM using Outlook VBA Form Outlook VBA and Custom Forms 2
M Outlook 2016 outlook vba to look into shared mailbox Outlook VBA and Custom Forms 0
V VBA Categories unrelated to visible calendar and Visual appointment Categories Outlook VBA and Custom Forms 2
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
R Outlook 365 VBA AUTO SEND WITH DELAY FOR EACH EMAIL Outlook VBA and Custom Forms 0
R Outlook 2019 VBA to List Meetings in Rooms Outlook VBA and Custom Forms 0
geoffnoakes Counting and/or listing fired reminders via VBA Using Outlook 1
O VBA - Regex - remove double line spacing Outlook VBA and Custom Forms 1
D.Moore Strange VBA error Outlook VBA and Custom Forms 4
D Outlook 2021 Using vba code to delete all my spamfolders not only the default one. Outlook VBA and Custom Forms 0
K vba code to auto download email into a specific folder in local hard disk as and when any new email arrives in Inbox/subfolder Outlook VBA and Custom Forms 0
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
MattC Changing the font of an email with VBA Outlook VBA and Custom Forms 1
P MailItem.To Property with VBA not work Outlook VBA and Custom Forms 2
P Tweak vba so it can target another mailbox Outlook VBA and Custom Forms 1
A Outlook 2010 VBA fails to launch 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
W Create a Quick Step or VBA to SAVE AS PDF in G:|Data|Client File Outlook VBA and Custom Forms 1
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
D VBA Macro to Print and Save email to network location Outlook VBA and Custom Forms 1
TedSch Small vba to kill political email Outlook VBA and Custom Forms 3
E Outlook 365 Outlook/VBA Outlook VBA and Custom Forms 11

Similar threads

Back
Top