VB script only runs manually

Layla

Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
Hi,

Im having an issue with my script not running automatically. I have a script where i want it to highligh certain keywords in incoming emails. Ive tested this script and it works, it even worked automatically in the beginning for incoming emails, then suddenly it stops working and i just cant get whats wrong. Im kind of new to this and therefore not an experienced user. So i need all the help i can get.

Code:
Public WithEvents GMailItems As Outlook.Items
'UpdatebyExtendoffice20181106
Private Sub Application_Startup()
    Set GMailItems = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub GMailItems_ItemAdd(ByVal Item As Object)
    If Item.Class <> olMail Then Exit Sub
    AutoHighlight_SpecificWords Item
End Sub
Sub AutoHighlight_SpecificWords(Mail As Outlook.MailItem)
    Dim xWord As Variant
    Dim xHTMLBody As String, xStr As String
    Dim xWordArr
    On Error Resume Next
    xWordArr = Array("Order nr", "Name", "Address", "Workplace")  'keyword
    xHTMLBody = Mail.HTMLBody
    For Each xWord In xWordArr
        If InStr(xHTMLBody, xWord) > 0 Then
            xStr = "<font style=" & Chr(34) & "background-color: yellow" & Chr(34) & ">" & xWord & "</font>"
            xHTMLBody = Replace(xHTMLBody, xWord, xStr)
            Mail.HTMLBody = xHTMLBody
        End If
    Next
    Mail.Save
End Sub
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Start with commenting out the on error resume next line - when it fails, it should let you know.

In the editor's tools > options > general, check your error handling settings. Try break on all errors, until you determine the cause.
2021-01-21_08-08-55-0000.gif


You can use this macro to step through each line of your macro and see where it might be dying. Select a message then run / step into this to run it.

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
AutoHighlight_SpecificWords objItem

End Sub
 

Layla

Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
Start with commenting out the on error resume next line - when it fails, it should let you know.

In the editor's tools > options > general, check your error handling settings. Try break on all errors, until you determine the cause.
View attachment 3204

You can use this macro to step through each line of your macro and see where it might be dying. Select a message then run / step into this to run it.

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
AutoHighlight_SpecificWords objItem

End Sub
The code is working. I deleted mail rule in outlook och created a new one, same script as above and so far soo good.
But what about if I want to use a similar script for another client, that is same script but that hightlights different keywords. It seems like i can online have only one outlook object?

1611669890077.png
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
to use it with two (or more) and use different keywords, you have two options.
1. use stub macros to set variables then pass the variable to the main macro that does the work.
2. use an if statement to check the from address then set the keywords.


Hmm. You are watching the inbox with this macro, so don't need to use a rule - in any event, the method is the same if you use an itemadd or rules.


To watch the second mailbox, you need the getfolderpath macro at
Working with VBA and non-default Outlook Folders (slipstick.com)


Code:
Public WithEvents GMailItems As Outlook.Items
Public WithEvents nMailItems As Outlook.Items
Dim xWord As Variant

Private Sub Application_Startup()
    Set GMailItems = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
    Set nMailItems = GetFolderPath("datafilename\inbox").Items
End Sub

Private Sub GMailItems_ItemAdd(ByVal Item As Object)
xWordArr = Array("Order nr", "Name", "Address", "Workplace")  'keyword
    AutoHighlight_SpecificWords Item
End sub

Private Sub nMailItems_ItemAdd(ByVal Item As Object)
xWordArr = Array("new words", "test ", "phone", "whatever")  'keyword
    AutoHighlight_SpecificWords Item
End sub

' these two should have different names if you want the option to use a rule
Private Sub AutoHighlight_SpecificWords(ByVal Item As Object)
    If Item.Class <> olMail Then Exit Sub
    AutoHighlight_SpecificWords Item
End Sub


Sub AutoHighlight_SpecificWords(Mail As Outlook.MailItem)
    Dim xWord As Variant
    Dim xHTMLBody As String, xStr As String

    On Error Resume Next
   
xHTMLBody = Mail.HTMLBody
    For Each xWord In xWordArr

        If InStr(xHTMLBody, xWord) > 0 Then
            xStr = "<font style=" & Chr(34) & "background-color: yellow" & Chr(34) & ">" & xWord & "</font>"
            xHTMLBody = Replace(xHTMLBody, xWord, xStr)
            Mail.HTMLBody = xHTMLBody
        End If
    Next
    Mail.Save
End Sub

This is the other option -

Code:
Public WithEvents GMailItems As Outlook.Items
Public WithEvents nMailItems As Outlook.Items

Private Sub Application_Startup()
    Set GMailItems = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
    Set nMailItems = GetFolderPath("datafilename\inbox").Items
End Sub

Private Sub GMailItems_ItemAdd(ByVal Item As Object)
    If Item.Class <> olMail Then Exit Sub
    AutoHighlight_SpecificWords Item
End sub

Private Sub nMailItems_ItemAdd(ByVal Item As Object)
    If Item.Class <> olMail Then Exit Sub
    AutoHighlight_SpecificWords Item
End sub


Sub AutoHighlight_SpecificWords(Mail As Outlook.MailItem)
    Dim xWord As Variant
    Dim xHTMLBody As String, xStr As String
    Dim xWordArr
    On Error Resume Next

if mail.senderemailaddress is "abc@xyz.com" then
    xWordArr = Array("Order nr", "Name", "Address", "Workplace")  'keyword
end if

if mail.senderemailaddress is "zxy@cba.com" then
  xWordArr = Array("new words", "test ", "phone", "whatever")  'keyword
end if

    xHTMLBody = Mail.HTMLBody
    For Each xWord In xWordArr
        If InStr(xHTMLBody, xWord) > 0 Then
            xStr = "<font style=" & Chr(34) & "background-color: yellow" & Chr(34) & ">" & xWord & "</font>"
            xHTMLBody = Replace(xHTMLBody, xWord, xStr)
            Mail.HTMLBody = xHTMLBody
        End If
    Next
    Mail.Save
End Sub
 

Layla

Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
to use it with two (or more) and use different keywords, you have two options.
1. use stub macros to set variables then pass the variable to the main macro that does the work.
2. use an if statement to check the from address then set the keywords.


Hmm. You are watching the inbox with this macro, so don't need to use a rule - in any event, the method is the same if you use an itemadd or rules.


To watch the second mailbox, you need the getfolderpath macro at
Working with VBA and non-default Outlook Folders (slipstick.com)


Code:
Public WithEvents GMailItems As Outlook.Items
Public WithEvents nMailItems As Outlook.Items
Dim xWord As Variant

Private Sub Application_Startup()
    Set GMailItems = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
    Set nMailItems = GetFolderPath("datafilename\inbox").Items
End Sub

Private Sub GMailItems_ItemAdd(ByVal Item As Object)
xWordArr = Array("Order nr", "Name", "Address", "Workplace")  'keyword
    AutoHighlight_SpecificWords Item
End sub

Private Sub nMailItems_ItemAdd(ByVal Item As Object)
xWordArr = Array("new words", "test ", "phone", "whatever")  'keyword
    AutoHighlight_SpecificWords Item
End sub

' these two should have different names if you want the option to use a rule
Private Sub AutoHighlight_SpecificWords(ByVal Item As Object)
    If Item.Class <> olMail Then Exit Sub
    AutoHighlight_SpecificWords Item
End Sub


Sub AutoHighlight_SpecificWords(Mail As Outlook.MailItem)
    Dim xWord As Variant
    Dim xHTMLBody As String, xStr As String

    On Error Resume Next
  
xHTMLBody = Mail.HTMLBody
    For Each xWord In xWordArr

        If InStr(xHTMLBody, xWord) > 0 Then
            xStr = "<font style=" & Chr(34) & "background-color: yellow" & Chr(34) & ">" & xWord & "</font>"
            xHTMLBody = Replace(xHTMLBody, xWord, xStr)
            Mail.HTMLBody = xHTMLBody
        End If
    Next
    Mail.Save
End Sub

This is the other option -

Code:
Public WithEvents GMailItems As Outlook.Items
Public WithEvents nMailItems As Outlook.Items

Private Sub Application_Startup()
    Set GMailItems = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
    Set nMailItems = GetFolderPath("datafilename\inbox").Items
End Sub

Private Sub GMailItems_ItemAdd(ByVal Item As Object)
    If Item.Class <> olMail Then Exit Sub
    AutoHighlight_SpecificWords Item
End sub

Private Sub nMailItems_ItemAdd(ByVal Item As Object)
    If Item.Class <> olMail Then Exit Sub
    AutoHighlight_SpecificWords Item
End sub


Sub AutoHighlight_SpecificWords(Mail As Outlook.MailItem)
    Dim xWord As Variant
    Dim xHTMLBody As String, xStr As String
    Dim xWordArr
    On Error Resume Next

if mail.senderemailaddress is "abc@xyz.com" then
    xWordArr = Array("Order nr", "Name", "Address", "Workplace")  'keyword
end if

if mail.senderemailaddress is "zxy@cba.com" then
  xWordArr = Array("new words", "test ", "phone", "whatever")  'keyword
end if

    xHTMLBody = Mail.HTMLBody
    For Each xWord In xWordArr
        If InStr(xHTMLBody, xWord) > 0 Then
            xStr = "<font style=" & Chr(34) & "background-color: yellow" & Chr(34) & ">" & xWord & "</font>"
            xHTMLBody = Replace(xHTMLBody, xWord, xStr)
            Mail.HTMLBody = xHTMLBody
        End If
    Next
    Mail.Save
End Sub

Thanks for your answers Diane. So if i want to run this macro on a shared mailbox instead, what changes needs to be done in your code? Sorry if im asking really basic questions, but im really new to this :)
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Sorry about that. I wasn't thinking or would have used it instead of second account. :)

assuming you need both shared exchange and gmail....
Code:
Private Sub Application_Startup()


Dim NS As Outlook.NameSpace
  Dim objOwner As Outlook.Recipient
  
  Set NS = Application.GetNamespace("MAPI")
  Set objOwner = NS.CreateRecipient("maryc")
    objOwner.Resolve
      
 If objOwner.Resolved Then
   'MsgBox objOwner.Name

 Set nMailItems = NS.GetSharedDefaultFolder(objOwner, olFolderInbox).items
 End If

    Set GMailItems = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items

End Sub


Use a shared folder (Exchange mailbox)
 
Similar threads
Thread starter Title Forum Replies Date
D Script only runs on my PC Outlook VBA and Custom Forms 10
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
E Having some trouble with a run-a-script rule (moving mail based on file type) Outlook VBA and Custom Forms 5
D.Moore VB script to Digitaly Sign newly created outlook message Outlook VBA and Custom Forms 2
Aussie Rules Run a Script on an Incoming Email OK and then the Email reverts Outlook VBA and Custom Forms 0
D.Moore VBA script fail after Office 365 update Using Outlook 8
M Outlook 2013 Script Assistance - Save Opened Link with Subject Added Outlook VBA and Custom Forms 1
F Script for zip file attachment Outlook VBA and Custom Forms 1
S Change VBA script to send HTML email instead of text Outlook VBA and Custom Forms 3
Y Outlook 2013 Run A Script Outlook VBA and Custom Forms 4
Z Script to set account? Using Outlook 0
dweller Outlook 2010 Rule Ignores VBA Script Outlook VBA and Custom Forms 2
N VBA Script to Open highlighted e-mail and Edit Message Outlook VBA and Custom Forms 5
B Outlook rule run a Script doesn't work Outlook VBA and Custom Forms 1
J Calling a Public sub-routine from the script editor via VB script Outlook VBA and Custom Forms 4
K Outlook Archive to PST Files by Date Range VBA Script? Outlook VBA and Custom Forms 1
Peter H Williams Enable script containing VBA Outlook VBA and Custom Forms 12
H VB script in outlook form doesn't work anymore Outlook VBA and Custom Forms 2
A Script to fetch data from mails in restricted collection and sending them to excel Using Outlook 1
B Wanting to run a script that will filter any body that has a russian link in it. Outlook VBA and Custom Forms 5
Bri the Tech Guy Registry Tweak to make "Run a Script" Action Available Outlook VBA and Custom Forms 2
V VB script code to save a specific email attachment from a given email Outlook VBA and Custom Forms 14
Bri the Tech Guy Run Script rule not running for newly arriving messages Outlook VBA and Custom Forms 25
M Subject Line Automation - Trigger Script Delayed Outlook VBA and Custom Forms 2
Q Script to create a pst file for Archiving Using Outlook 1
Vijay Error in rule- Run a script Using Outlook 1
R VBA Script Quick Parts Using Outlook 1
Vijay Run script doesn't work in outlook Using Outlook 1
Q VBA Script to move item in secondary mailbox Outlook VBA and Custom Forms 2
Diane Poremsky Run a Script Rule: Send a New Message when a Message Arrives New Slipstick.com Articles 2
F Avoid sending duplicate using Outlook script Outlook VBA and Custom Forms 2
oliv- How to Run a Script IN AN ADDIN with Outlook's Rules and Alerts Outlook VBA and Custom Forms 2
L Run a Script Rule doesn't work Using Outlook 5
N Outlook script to forward emails based on senders' address Outlook VBA and Custom Forms 2
S using script rule to save attachments on arrival Outlook 2010 Outlook VBA and Custom Forms 9
X Outlook script to run excel data Outlook VBA and Custom Forms 1
N VBA Script to Send Automatic Emails from Outlook 2010 Outlook VBA and Custom Forms 1
Davzell Change default pop3 account with script, prf or registery ? Outlook VBA and Custom Forms 0
D RUN SCRIPT WHEN OUTLOOK IS CLOSE Outlook VBA and Custom Forms 1
L Cannot run script from rule Outlook VBA and Custom Forms 7
O modify vba to run it as script rule Outlook VBA and Custom Forms 8
D Script to parse email and set a task Outlook VBA and Custom Forms 1
L Moving Message Class email via script and Rule Outlook VBA and Custom Forms 3
P How many subs can run in one outlook VBA script Using Outlook 5
H Customizing "Send to" Attachment Script Outlook VBA and Custom Forms 5
G Script in rule to send to multiple emails found in message bo Outlook VBA and Custom Forms 11
Xueying run a script in rules, first time succeed, failed afterwards Outlook VBA and Custom Forms 3
A Creating archive rule on the clients by script/ Outlook VBA and Custom Forms 3
J VBS Script (macro) for word to open Outlook template. Outlook VBA and Custom Forms 2

Similar threads

Top