Enumerating the Event Sink Bindings for a Folder

Public Sub Enum_Event(Server As String)
  On Error Resume Next
  Dim Query
  Dim fld
  
  Dim rs As ADODB.Recordset
  Dim strParentFolder
  Dim strEventRegistrationName
  Dim aPropNames
  
  aPropNames = Array( _
    "DAV:contentclass", _
    "http://schemas.microsoft.com/exchange/events/EventMethod", _
    "http://schemas.microsoft.com/exchange/events/SinkClass", _
    "http://schemas.microsoft.com/exchange/events/Priority", _
    "http://schemas.microsoft.com/exchange/events/Scope", _
    "http://schemas.microsoft.com/exchange/events/MatchScope", _
    "http://schemas.microsoft.com/exchange/events/Criteria", _
    "http://schemas.microsoft.com/exchange/events/Reliable", _
    "http://schemas.microsoft.com/exchange/events/TimerInterval", _
    "http://schemas.microsoft.com/exchange/events/TimerStartTime", _
    "http://schemas.microsoft.com/exchange/events/TimerExpiryTime", _
    "http://schemas.microsoft.com/exchange/events/ScriptName")
      

  ' Specify the event folder and the event registration name
  strParentFolder = "file://./backofficestorage/" + _
                     Server + "/mbx/user1/inbox"
  
  strEventRegistrationName = "evtreg1"  'If you want to enum all the events, then leave this blank
    
  'Build the sql query to get the events
  'This section gets all event types so that you don't have to change this per event type
  'To limit the event types, remove the unwanted event types from aPropNames
  Dim i

  Query = "SELECT "
  For i = LBound(aPropNames) To UBound(aPropNames)
    Query = Query + Chr(34) + aPropNames(i) + Chr(34)
    If i <> UBound(aPropNames) Then
      Query = Query + ", "
    End If
  Next
  Query = Query + " FROM SCOPE('shallow traversal of " + Chr(34) + strParentFolder + Chr(34) + "')"
  Query = Query + " WHERE " + Chr(34) + "DAV:contentclass" + Chr(34) + " = 'urn:content-class:storeeventreg'"
  If strEventRegistrationName <> "" Then
    'event folder name specified
    Query = Query + " AND " + Chr(34) + "DAV:displayname" + Chr(34) + " = '" + strEventRegistrationName + "'"
  End If

  
  Dim rec As New ADODB.Record
  rec.Open strParentFolder  'root binder will select the correct provider
  If Err.Number <> 0 Then
    Debug.Print "Error Executing Query : " & Err.Number & " " & Err.Description & vbCrLf
    Exit Sub
  End If
 
  rs.Open Query, rec.ActiveConnection
  If Err.Number <> 0 Then
    Debug.Print "Error Executing Query : " & Err.Number & " " & Err.Description & vbCrLf
    Exit Sub
  End If

  ' Go thru each entry in the recordset
  Do While (rs.BOF <> True And rs.EOF <> True)
    For Each fld In rs.Fields
      If fld.Value <> vbNull Then
        Debug.Print fld.name & ", " & fld.Value & vbCrLf
      End If
    Next
    Debug.Print "***********************************************" & vbCrLf
    rs.MoveNext
    If Err.Number <> 0 Then
      Debug.Print "Error Moving To Next Record : " & Err.Number & " " & Err.Description & vbCrLf
      Exit Sub
    End If
  Loop

End Sub