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
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
DisplayError "Unable to get current Outlook session, make sure " & _
"Outlook 2007 is running."
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
DisplayError "Unable to get Folder."
Dim oStore 'As Outlook.Store
Set oStore = oFolder.Store
DisplayError "Unable to get Store."
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."
If choice = 6 Then
oStore.PropertyAccessor.SetProperty CrawlSourceSupportMask, CLNG(1)
ElseIf choice = 7 Then
oStore.PropertyAccessor.SetProperty CrawlSourceSupportMask, CLNG(0)
DisplayError "Failed to set CrawlSourceSupportMask."
MsgBox "Success! Do Not Crawl has been enabled on this store."
MsgBox "Success! Do Not Crawl has been disabled on this store."
End Sub
Sub DisplayError(strMessage)
MsgBox strMessage & vbCrlf & vbCrlf & _
"Error Information" & vbCrlf & _
"Number: " & Err.number & vbCrlf & _
"Description: " & Err.Description, ,"Error!"