The Sample Script COUNTERV.TXT

The following sample script ships with Microsoft Exchange Server version 5.5 and above. It contains the four basic functions Folder_OnMessageCreated, Message_OnChange, Folder_OnMessageDeleted, and Folder_OnTimer.

Each of these event functions calls two support functions: first GetEventDetails, and then MakeResponseMessage, as described in the following sections.

The GetEventDetails Function

In addition to error checking, the function GetEventDetails performs the following steps:

1. Using the CDO session, it establishes the location of the current user's Microsoft Exchange mailbox. It does this with the call
   Set CDOSession = EventDetails.Session.
2. It retrieves the user's Outbox with the call
   Set fldrOutbox = AMSession.Outbox.
3. Using the EventDetails object passed by the Microsoft Exchange Event Service, this function sets an application folder ("target" folder) to be the same as the monitored folder in which the event occurred. It does this with the assignments
   Set fldrTarget = CDOSession.GetFolder( EventDetails.FolderID, Null ).
4. This function also sets a target message to be the same as the message that triggered the event. It does this with the assignments
   Set msgTarget = CDOSession.GetMessage( EventDetails.MessageID, Null ).

The SendResponseMessage Function

In addition to error checking, the function SendResponseMessage prepares and sends a response message that reports the number of messages in the monitored folder. For this, it uses the CDO response object in the call msgResponse.Send.

Script Text: COUNTERV.TXT

<SCRIPT Language="VBScript">

'---------------------------------------------------------------------
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY
' OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING 
' BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY
' AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' 
' Copyright (c) Microsoft Corporation 1993-1998. All rights reserved.
'---------------------------------------------------------------------

Option Explicit 

'---------------------------------------------------------------------
' Global Variables
'---------------------------------------------------------------------

Dim g_bstrDebug   ' debug string
Dim g_CdoPR_CONTENT_COUNT
g_CdoPR_CONTENT_COUNT = &H36020003   ' message count in Folder


'---------------------------------------------------------------------
' Event Handlers
'---------------------------------------------------------------------

' DESCRIPTION: This event is fired when a new message is added to the folder
Public Sub Folder_OnMessageCreated

  Call DebugAppend(vbCrLf & "COUNTERV - Folder_OnMessageCreated",False)
  Call SendResponseMessage("A New Message Was Created")
  Script.Response = g_bstrDebug

End Sub

' DESCRIPTION: This event is fired when a message in the folder is changed
Public Sub Message_OnChange

  Call DebugAppend(vbCrLf & "COUNTERV - Message_OnChange",False)
  Call SendResponseMessage("A Message has Changed")
  Script.Response = g_bstrDebug

End Sub

' DESCRIPTION: This event is fired when a message is deleted from the folder
Public Sub Folder_OnMessageDeleted

  Script.Response = vbCrLf & "COUNTERV - Folder_OnMessageDeleted"
 
End Sub

' DESCRIPTION: This event is fired when the timer on the folder expires
Public Sub Folder_OnTimer

    Script.Response = vbCrLf & "COUNTERV - Folder_OnTimer"

End Sub

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'
' 
'---------------------------------------------------------------------
' Name: SendResponseMessage
' Area: Application
' Desc: Get the various CDO objects and send a message
' Parm: bstrSubject -  text to send in the subject of the message
'---------------------------------------------------------------------

Private Sub SendResponseMessage(bstrSubject)
  On Error Resume Next
  
  Dim CDOSession    ' Session Object
  Dim oMsg          ' Message Object
  Dim oFolder       ' Current Folder Object
  Dim oFolderOutbox ' Outbox for session
  Dim oMsgTarget    ' Target Msg Object
  Dim oRec          ' Recipients Container Object
  Dim iMsgCount     ' Message count

  Set CDOSession = EventDetails.Session  ' get CDO session from 
                                         ' EventDetails intrinsic obj
  Call DebugAppend("EventDetails.Session",True)

  Set oFolderOutbox = CDOSession.Outbox  ' get session outbox
  Call DebugAppend("CDOSession.Outbox",True)

  '  Now we fetch the folder using the FolderID passed to us
  ' in the EventDetails object.
  Set oFolder = CDOSession.getFolder(EventDetails.FolderID,Null)
  Call DebugAppend("CDOSession.getFolder()",True)

  '  Get the binding message using the MessageID passed to us
  '  in the EventDetails object
  set oMsgTarget = CDOSession.GetMessage(EventDetails.MessageID,Null)
  Call DebugAppend("CDOSession.GetMessage()",True)

  '  Get the number of messages in the event source folder
  iMsgCount = oFolder.Fields(g_CDO_PR_CONTENT_COUNT)
  Call DebugAppend("oFolder.Fields(g_CDO_PR_CONTENT_COUNT)",True)

  ' Create Message in Outbox
  Set oMsg = OFolderOutbox.Messages.Add(CStr(bstrSubject), _
     "There are now " & CStr(iMsgCount) & " messages in " & oFolder.Name )
  Call DebugAppend("Outbox.Messages.Add",True)
  
  Set oRec = oMsg.Recipients
  oRec.Add "", "", 1, oMsgTarget.Sender.ID
  oRec.Resolve(False)
  If oRec.Resolved = True Then
    oMsg.Send
    If err.number <> 0 Then
      Call DebugAppend("oMsg.send",True)
    Else
      Call DebugAppend("Message sent",False)
    End If
  Else
    Call Debug.Append("Recipient.Resolve",True)
  End If
  
End Sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'
' 
'---------------------------------------------------------------------
' Name: DebugAppend
' Area: Debug
' Desc: Appends passed string to global string buffer. Checks for error
'       with ErrChkFlag set to True.  If found, appends Error info as well
' Parm: String text, Bool ErrorFlag
'---------------------------------------------------------------------
Private Sub DebugAppend(bstrParm, boolErrChkFlag)
  if boolErroChkFlag = True Then
    if err.number <> 0 Then  ' check for COM error
     g_bstrDebug = g_bstrDebug & bstrParm & "Failed: " _
      & CStr(err.number) & ":" & CStr(err.description) & vbCrLf
     err.clear
    End If
   Else
     g_bstrDebug = g_bstrDebug & bstrParm & vbCrLf
   End If
End Sub

</SCRIPT>