OUTBOX: Setting ‘Don’t Crawl On Me’ via Outlook’s object model

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 = "https://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