Share via


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