A while ago Steve posted information about how to turn of various types of “crawling” in Outlook via named properties that can be set on a store to tell Outlook whether or not it is okay to “crawl” the store in different scenarios. There are cases where you might have tons of folders in a store and you don’t want Outlook to enumerate all these folders because it would impact performance. I was recently asked if these properties could be set via a simple VB script. Turns out it is pretty straight forward to set this property via the PropertyAccessor in Outlook’s object model.
The following script will work with Outlook 2007 and greater. It is simply a sample script which can be used to set the CrawlSourceSupportMask to enable or disable Outlook crawling a store to look for Contact, Task, and Calendar folders in an opened store. You could easily modify this script to set ArchiveSourceSupportMask if you needed to – this disables/enables Outlook crawling open stores looking for folders that need to be archived.
Option Explicit
Main()
Sub Main
On Error Resume Next
Dim oApplication 'As Outlook.Application
Set oApplication = CreateObject("Outlook.Application")
If Err.number <> 0 Then
DisplayError "Unable to get Outlook application object, " & _
"make sure Outlook 2007 is installed on this computer."
Exit Sub
End If
Dim oSession 'As Outlook.Namespace
Set oSession = oApplication.Session
If Err.number <> 0 Then
DisplayError "Unable to get current Outlook session, make sure " & _
"Outlook 2007 is running."
Exit Sub
End If
MsgBox "Choose an Outlook message store to configure.", _
1, _
"Configure Outlook Do Not Crawl"
Dim oFolder 'As Outlook.Folder
Set oFolder = oSession.PickFolder
If oFolder Is Nothing Then
Exit Sub
End If
If Err.number <> 0 Then
DisplayError "Unable to get Folder."
Exit Sub
End If
Dim oStore 'As Outlook.Store
Set oStore = oFolder.Store
If Err.number <> 0 Then
DisplayError "Unable to get Store."
Exit Sub
End If
Dim choice
choice = MsgBox ("Do you want Outlook to crawl the message store you selected?", _
4, _
"Configure Outlook Do Not Crawl")
Dim CrawlSourceSupportMask
CrawlSourceSupportMask = "http://schemas.microsoft.com/mapi/string/" & _
"{00062008-0000-0000-C000-000000000046}/CrawlSourceSupportMask"
Dim propValue
propValue = oStore.PropertyAccessor.GetProperty(CrawlSourceSupportMask)
If Err.number = -2147221233 Then
MsgBox "CrawlSourceSupportMask is not currently set, click OK to create it and set it."
Err.Clear
ElseIf Err.number <> 0 Then
DisplayError "Unable to get CrawlSourceSupportMask property."
Exit Sub
End If
If choice = 6 Then
oStore.PropertyAccessor.SetProperty CrawlSourceSupportMask, CLNG(1)
ElseIf choice = 7 Then
oStore.PropertyAccessor.SetProperty CrawlSourceSupportMask, CLNG(0)
End If
If Err.number <> 0 Then
DisplayError "Failed to set CrawlSourceSupportMask."
Exit Sub
End If
If choice = 6 Then
MsgBox "Success! Do Not Crawl has been enabled on this store."
ElseIf choice = 7 Then
MsgBox "Success! Do Not Crawl has been disabled on this store."
End If
End Sub
Sub DisplayError(strMessage)
MsgBox strMessage & vbCrlf & vbCrlf & _
"Error Information" & vbCrlf & _
"Number: " & Err.number & vbCrlf & _
"Description: " & Err.Description, ,"Error!"
End Sub
