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.
Thread starter Similar threads Forum Replies Date
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.Moore VBA script fail after Office 365 update Using Outlook 6
R Limiting length of saved attachment in VBA Outlook VBA and Custom Forms 2
S Skype for business meeting vba code Outlook VBA and Custom Forms 1
C How to use VBA to show only items x days old or more Outlook VBA and Custom Forms 1
B VBA to convert email to task, insert text of email in task notes, and attach copy of original email Outlook VBA and Custom Forms 4
D Outlook VBA error extracting property data from GetRules collection Outlook VBA and Custom Forms 10
S Reference Custom Fields with VBA Outlook VBA and Custom Forms 2
PGSystemTester VBA To Change AppointmentItem.BusyStatus From MeetingItem Before Send Using Outlook 0
A VBA macro for 15 second loop in send and received just for 1 specific mailbox Outlook VBA and Custom Forms 1
O Email not leaving Outbox when using Excel VBA to sync Outlook account Outlook VBA and Custom Forms 4
G VBA Macro Calendar Printing Assistant 3
R Help Revising VBA macro to delete email over different time span Outlook VBA and Custom Forms 0
B VBA to Collapse Task Folder Groups Outlook VBA and Custom Forms 1
R Expand VBA Permanent Delete Code Outlook VBA and Custom Forms 6
shrydvd vba to secure zip attachments Outlook VBA and Custom Forms 3
M Adding Subject to this Link-Saving VBA Outlook VBA and Custom Forms 4
N VBA to delete duplicates by message-id on common pst for 2 or more emails Outlook VBA and Custom Forms 0
S Change VBA script to send HTML email instead of text Outlook VBA and Custom Forms 3
M VBA to auto forward message with new subject and body text Outlook VBA and Custom Forms 8
A Custom VBA to sort emails into folders Outlook VBA and Custom Forms 0
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
R VBA for copying sent email to current folder under a shared mailbox Outlook VBA and Custom Forms 17
A Edit subject - and change conversationTopic - using VBA and redemption Outlook VBA and Custom Forms 2
N How can I increase/faster outlook VBA Macro Speed ? Using Outlook 2
A VBA Code in Outlook disappears after first use Outlook VBA and Custom Forms 1
B Clear Offline Items (Mail Folder) via VBA Outlook VBA and Custom Forms 1
D.Moore Folder view settings by VBA macro Outlook VBA and Custom Forms 57
F VBA to ensure a code is entered in Subject title Outlook VBA and Custom Forms 1
B Vba to monitor time to respond to emails using a shared mailbox Outlook VBA and Custom Forms 5
N VBA Script to Open highlighted e-mail and Edit Message Outlook VBA and Custom Forms 5
G Outlook VBA and Google Calendar ("Events") Outlook VBA and Custom Forms 1
B Looking to get the Recipient email address (or even the "friendly name") from an email I am replying to using VBA Outlook VBA and Custom Forms 4
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
M VBA to send reminder email if no response Using Outlook 13
Similar threads


















































Top