Problem running a VBA script from an Outlook rule

[Olivier Langlois]

Hi,

I wrote a VBA subroutine that is called from an Outlook rule. What the
subroutine does is to look into the MailItem.body to search for certain
keywords and based on the result, move the mailItem in a given folder.

Since I wrote this script, a couple of annoying things happened. First,
I had few other scripts used in Outlook rules but since I wrote the one
accessing the MailItem.body property, I had to lower my Macro security
level from High to Medium because otherwise my macros are deactivated.

Second, everytime my new macro is executed, I get the extremely
annoying Security warning popup window and I would like to get rid of
it. It is written in the Outlook doc:

You can avoid the display of security warnings by deriving all objects,
properties, and methods from the Application object passed in the
OnConnection procedure of the add-in. Outlook trusts only the
Application object passed in the OnConnection procedure of the add-in.
If you create a new Application object- for example, by using the
CreateObject method- that object and any of its subordinate objects,
properties, and methods will not be trusted and the blocked properties
and methods will throw security warnings.

Unfortunatly, I am not able to decrypt the meaning of the last
paragraph. Is there someone who could tell me what I could do with my
VBA script used in a Outlook rule to get rid the security warning?

Thank you,
Olivier Langlois
http://www3.sympatico.ca/olanglois

Here is the code of my macro:

Sub CustomCVSMessageRule(Item As Outlook.MailItem)
Dim BodyStr As String
Dim BranchName As String
Dim BugNumber As String

Dim CommaPos As Integer
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.MAPIFolder
Dim myDestFolder As Outlook.MAPIFolder

Set myNameSpace = GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)

BodyStr = Item.Body
' Try to find a bug number
BugNumber = FindBugNumber(BodyStr)
If Len(BugNumber) > 0 Then
' Place the e-mail in the bugs subfolder
Set myDestFolder = FindOrCreateFolder(myInbox, "Bugs")
Set myDestFolder = FindOrCreateFolder(myDestFolder, BugNumber)
Else
Set myDestFolder = FindOrCreateFolder(myInbox, "CVS")
BranchName = FindBranchName(BodyStr)
If Len(BranchName) > 0 Then
' Place the mail in CVS subfolder
Set myDestFolder = FindOrCreateFolder(myDestFolder,
BranchName)
End If
End If

Item.Move myDestFolder
End Sub

Function FindBugNumber(inputStr As String) As String
Dim bracketStart As Integer
Dim bracketEnd As Integer
FindBugNumber = ""
bracketStart = InStr(inputStr, "[Bug")
If bracketStart = 0 Then
' There is no bug string
Exit Function
End If
' Skip "[Bug "
bracketStart = bracketStart + 5
bracketEnd = InStr(bracketStart, inputStr, "]")
FindBugNumber = Mid$(inputStr, bracketStart, bracketEnd -
bracketStart)
End Function

Function FindBranchName(inputStr As String) As String
Dim bracketStart As Integer
Dim bracketEnd As Integer
FindBranchName = ""
bracketStart = InStr(inputStr, "BRANCH: ")
If bracketStart = 0 Then
' There is not BRANCH string
Exit Function
End If
' Skip "BRANCH: "
bracketStart = bracketStart + 8
bracketEnd = InStr(bracketStart, inputStr, Chr$(13))
FindBranchName = Mid$(inputStr, bracketStart, bracketEnd -
bracketStart)
End Function

Function FindOrCreateFolder(inputFolder As Outlook.MAPIFolder,
folderName As String) As Outlook.MAPIFolder
Dim curFolder As Outlook.MAPIFolder
For Each curFolder In inputFolder.Folders
If folderName = curFolder.Name Then
Set FindOrCreateFolder = curFolder
Exit Function
End If
Next curFolder
Set FindOrCreateFolder = inputFolder.Folders.Add(folderName)
End Function

Sub TestFindBranchName()
MsgBox FindBranchName(" BRANCH: r11sp" + Chr$(13) + Chr$(10) + "a
toto")
End Sub

 

[Sue Mosher [MVP-Outlook]]

Don't try to use the MailItem passed as a parameter. Instead, use its EntryID to get it as a "trusted" object derived from the intrinsic Application object, e.g.

Sub RunAScriptRuleRoutine(MyMail As MailItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem

strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = olNS.GetItemFromID(strID)
' do stuff with olMail, e.g.
MsgBox olMail.Body

Set olMail = Nothing
Set olNS = Nothing
End Sub

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers

 

[Olivier Langlois]

Hi Sue,

This is fantastic and exactly what I was looking for!!!

I just still have a very small question about your reply. I would say
that the script that I included with the original post is one of my
very first VBA experience and I'm just not quite sure why at the end of
your subroutine RunAScriptRuleRoutine, you set the local variables to
Nothing. Is there any particular reason for doing so? Is this a common
good VBA practice?

Thank you,
Olivier Langlois
http://www3.sympatico.ca/olanglois

 

[Sue Mosher [MVP-Outlook]]

It's always good practice to dereference your object variables when writing Outlook code, even though they're supposed to do that on their own when the procedure ends. It's somewhat essential when you get into writing COM add-ins and .NET code with Outlook objects.

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers

 

[Olivier Langlois]

I have implemented your solution in my script and it works like a
charm. Now, the remaining thing is what is the requirement that my
script needs to respect so it can work even if the Macro security level
is at high? Currently, I have to lower my Macro security level to
medium or low otherwise my script is disabled.

Thanks!
Olivier Langlois
http://www3.sympatico.ca/olanglois

 

[Sue Mosher [MVP-Outlook]]

You need to digitally sign the macro project. See http://www.outlookcode.com/d/vb.htm#selfcert

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers