Get The OOF Out Of Here

Dan asked if I could post some CDO sample code he was working on. This sample script demonstrates a few interesting things:

  • Dynamic session creation
  • Accessing the associated contents table of a folder using HiddenMessages
  • Looping backwards through a collection so deletion doesn't affect the cursor
  • Accessing properties documented in the Protocol Docs (PidTagRuleMsgProvider and PidTagRuleMsgName) using CDO's Fields collection

Ultimately, what this sample does is delete all Out Of Office related messages (rules and templates), and switch off Out Of Office. Be careful running this sample! It doesn't back up anything before it deletes the OOF messages. So be certain that's what you really want to do before you go running this sample against a production mailbox.

If you want to run this code on an Outlook 2007 machine, you'll need to have CDO installed: CDO Download. If you want to run it without any version of Outlook installed, you can use the MAPI/CDO download: MAPI/CDO Download.



' Deloof.vbs - This sample shows how to walk through hidden items in a mailbox and delete
'   the OOF templates and turn off OOF. 
' This is a sample and is not intended to be used in a production environment.
' This script needs to be run from a 32 bit command line using cscript on a box with CDO 1.21 installed.
' The account running the code needs permission to the mailbox it will access.
'  9/19/08 danba    - changed sample to include 6 message class tests.
'  9/23/08 danba    - changed logic for TDX OOF Rules - PidTagRuleMsgName may not always be set.
' 10/24/08 sgriffin - minor scrub to formatting
Private Function RunIt(sServerName, sMailbox)  'As Boolean
    Dim objsession            ' MAPI.Session
    Dim objInbox              ' MAPI.Folder
    Dim objHidden             ' MAPI.Messages
    Dim objMsgFilter          ' MAPI.MessageFilter
    Dim objOneMessage         ' MAPI.Message
    Dim sMessageClass         ' String  ' Message Class of rule
    Dim s_ptagRuleMsgProvider ' String  ' Provider of rule
    Dim s_ptagRuleMsgName     ' String  ' Rule name
    Dim sFoundMessage         ' String  ' Holds a message describing what was found.
    Dim bDelete               ' Boolean ' Used to indicate if an item should be deleted.
    Dim iHidden               ' Integer ' Use to loop through hidden items
    wscript.echo "-------------------------"
    wscript.echo "Time: " & Now
    Set objsession = CreateObject("MAPI.session")
    objsession.Logon "", "", False, False, 0, True, sServerName & vbLf & sMailbox
    wscript.echo "Login completed on mailbox " & sMailbox & " on server" & sServerName
    Set objInbox = objsession.Inbox
    wscript.echo "Looking at the Inbox"
    Set objHidden = objInbox.HiddenMessages
    wscript.echo "Looking at the Hidden Items"
    ' --- Now we have the Hidden messages Set. Let's work thru the Hidden Messages and delete the 'oof items'
    For iHidden = objHidden.Count To 1 Step -1    ' Walk Hidden backward one time
        bDelete = false
        sDeleteMessage = ""
        Set objOneMessage = objHidden.Item(iHidden)
        sMessageClass = objOneMessage.Type
        On Error Resume Next
        s_ptagRuleMsgProvider = ""
        s_ptagRuleMsgName = ""
        s_ptagRuleMsgProvider = objOneMessage.Fields(&H65EB001E) ' PidTagRuleMsgProvider
        s_ptagRuleMsgName = objOneMessage.Fields(&H65EC001E)     ' PidTagRuleMsgName
        sFoundMessage = "Class: """ & sMessageClass & """"
        if s_ptagRuleMsgName     <> "" Then sFoundMessage = sFoundMessage & " Name: """     & s_ptagRuleMsgName     & """"
        if s_ptagRuleMsgProvider <> "" Then sFoundMessage = sFoundMessage & " Provider: """ & s_ptagRuleMsgProvider & """"
        ' TODO: comment out line below if you don't wish to what was found
        Wscript.echo "  Found:    " & sFoundMessage
        If sMessageClass = "IPM.Rule.Message" Then
            If s_ptagRuleMsgProvider = "Microsoft Exchange OOF Assistant" AND _
              s_ptagRuleMsgName = "Microsoft.Exchange.OOF.InternalSenders.Global" Then
                bDelete = true
            End If
            If s_ptagRuleMsgProvider = "MSFT:TDX OOF Rules" Then
                bDelete = true
            End If
            If s_ptagRuleMsgProvider = "Microsoft Exchange OOF Assistant" AND _
              s_ptagRuleMsgName = "Microsoft.Exchange.OOF.AllExternalSenders.Global" Then
                bDelete = true
            End If
        End If
        If sMessageClass = "IPM.Note.Rules.OofTemplate.Microsoft" Then
            bDelete = true
        End If
        If sMessageClass = "IPM.Note.Rules.ExternalOofTemplate.Microsoft" Then
            bDelete = true
        End If
        If sMessageClass = "IPM.ExtendedRule.Message" Then
            If s_ptagRuleMsgProvider = "Microsoft Exchange OOF Assistant" AND _
              s_ptagRuleMsgName = "Microsoft.Exchange.OOF.KnownExternalSenders.Global" Then
                bDelete = true
            End If
        End If
        If bDelete = true  Then
            objHidden.Item(iHidden).Delete     ' TODO: Comment-out if testing
            wscript.echo "  Deleted:  " & sFoundMessage
        End If
    objsession.OutOfOffice = 0 ' Turn off OOF  ' TODO: Comment-out if testing
    Set objOneMessage = Nothing
    Set objInbox = Nothing
    Set objsession = Nothing
    wscript.echo "Finished"
    wscript.echo "-------------------------"
    RunIt = True
End Function
Dim bRet
If Wscript.Arguments.Count = 2 Then
    sServerName = Wscript.Arguments(0)
    sMailbox = Wscript.Arguments(1)
    bRet = RunIt(sServerName, sMailbox)
    Wscript.Echo "deloof.vbs usage: deloof.vbs <Exchange Server Name> <Mail Box>"
    Wscript.Echo "example: cscript deloof.vbs MyServer"
End If

Comments (2)

  1. Get The OOF Out Of Here Microsoft Software + Services and Cloud Computing Screencast: How to configure

  2. Oli says:

    Not working with Exchange 2013 (15) and OL2010

Skip to main content