MailboxCalendarDSTAudit.vbs: Audit Calendar for DST

Author: Robert Lawson
Environment: Windows Server, Exchange, Active Directory, vb-script
Description: This script was used to determine the number of users and extent of Exchange calendar events scheduled during the two 2007 extended Day Light Savings periods. This was handy as we were able to advise only those users with very specific corrective directions.
Code:

'=========================================================================
' FILE   : MailboxCalendarDSTAudit.vbs
' AUTHOR : Robert Lawson
' COMPANY: Soka University of America
' DATE   : 2/27/2007
' COMMENT: Daylight Savings Time audit of calendar
' KB 930879: Exchange Calendar Update Tool, daylight saving time
'=========================================================================
option explicit
On Error Resume Next
const conScriptName = "MailboxCalendarDSTAudit.vbs"
const conDEBUG = FALSE

Dim strMsg, strDateTime
Dim objShell, objFile, fso, fsoTemp, strScriptDir, strScriptName
Dim objNetwork, strUserName, strUserDomain, strComputerName
Dim objConnection, objCommand, rs, objRootDSE
Dim strQuery, UserADsPath, strDNSDomain
Dim strTempFile, objFileTemp, strTempDir
Dim strUserID, strdisplayName
Dim bolMailboxRights, bolFirst, bolDSTappoint, bolSender

Dim objSession, strProfileInfo 
Dim objMessage, objMessages, objFolder
Dim datStart, datEnd
Dim strServer, strUser, strDate, y
Dim numUserCount, numUserWithAppointCount, numAppointSingle, numAppointRecur
Dim numApptointSender

' Extended DST period: 11-Mar to 31-Mar; and 28-Oct to 03-Nov
Const conBeginDate = #3/11/2007#
Const conEndDate = #3/31/2007#

Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000 ' ADSI
Const ADS_SCOPE_SUBTREE = 2 ' ADSI

' ============================================================
' Get User Active Directory information
' ============================================================
set objConnection=Createobject("ADODB.Connection")
set objCommand=CreateObject("ADODB.Command")
objConnection.Provider="ADSDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
if err.number <> 0 then
 strMsg = conScriptName & ": ERROR.  Unable to establish AD connection"
 if conDEBUG then Wscript.Echo strMsg
 objShell.LogEvent 0,strMsg
 Wscript.QUIT
End if

Set objCommand.ActiveConnection = objConnection
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
if conDEBUG then Wscript.Echo "strDNSDomain = " & strDNSDomain

strQuery = "SELECT sAMAccountName, mail, displayName, ADsPath FROM 'LDAP://" & strDNSDomain & "' WHERE " & _
  "objectCategory='Person' AND objectClass='User' AND homeMDB='*'"
if conDEBUG then strQuery = strQuery & " AND (sAMAccountName = 'sleepy' or sAMAccountName = 'sneezy' or sAMAccountName = 'weepy')"
if conDEBUG then Wscript.Echo "strQuery = " & strQuery

objCommand.CommandText= strQuery
objCommand.Properties("Searchscope") =    ADS_SCOPE_SUBTREE
Set rs = objCommand.Execute
if err.number <> 0 then
 strMsg = conScriptName & ": ERROR.  Unable to query Active Directory"
 if conDEBUG then Wscript.Echo strMsg
 objShell.LogEvent 0,strMsg
 Wscript.QUIT
end if
if (rs.BOF or rs.EOF) then
 strMsg = conScriptName & ": ERROR.  No entries found in Active Directory"
 if conDEBUG then Wscript.Echo strMsg
 objShell.LogEvent 0,strMsg
 Wscript.QUIT
End if

numUserCount = 0
numUserWithAppointCount = 0
' header
wscript.Echo "User;Name;Recurruing;Single;Sender"
do while not rs.EOF
 numUserCount = numUserCount + 1
 'strUserADsPath = rs.fields("ADsPath").value
 'strsAMAccountName = rs.fields("sAMAccountName").value
 strServer = "server1.uni.edu"  ' get later
 strUser   =  rs.fields("mail").value
 strdisplayName = rs.Fields("displayName").value

  ' WScript.Echo "Working on " & strUser
 
 'Create Session object.
 err.clear   ' Unsure why this is needed here??
 Set objSession = CreateObject("MAPI.Session") 
 if Err.Number <> 0 Then     
  WScript.Echo "1Err = " & Err.Number & " " & Err.Description 
  Wscript.Quit
 End If  

 strProfileInfo = strServer & vbLf & strUser

 objSession.Logon , , False, True, , True, strProfileInfo 
 if Err.Number <> 0 Then    
  if not(Err.number = -2147221231 or err.number=-2147221219) then WScript.Echo strUser & " 2Err = " & Err.Number & " " & Err.Description 
  bolMailboxRights = FALSE
 else
  bolMailboxRights = TRUE
 End If


 if bolMailboxRights then
  ' http://msdn.microsoft.com/library/default.asp?url=/library/en-us/cdo/html/ad419f23-4215-49c8-a9b6-ae9ba49d2707.asp
  ' 13 = Pacific time zone (North America)

  Set objFolder = objSession.GetDefaultFolder(0)
  if Err.Number <> 0 Then
   WScript.Echo "3Err = " & Err.Number & " " & Err.Description 
   Wscript.Quit
  end if
  Set objMessages = objFolder.Messages
  if Err.Number <> 0 Then
   WScript.Echo "4Err = " & Err.Number & " " & Err.Description 
   Wscript.Quit
  end if

  bolFirst = true
  numAppointSingle = 0
  numAppointRecur = 0
  numApptointSender = 0
  For Each objMessage in objMessages
   strDate = objMessage.StartTime
   y = Instr(strDate, " ") - 1
   datStart = cDate(Left(strDate,y))

   strDate = objMessage.EndTime
   y = Instr(strDate, " ") - 1
   datEnd = cDate(Left(strDate,y))

   bolDSTappoint = ((datStart >= conBeginDate AND datStart <= conEndDate) _
   OR (datEnd >= conBeginDate and datEnd <= conEndDate))  _ 
   AND NOT objMessage.AllDayEvent
   bolSender = (objMessage.Sender = strdisplayName)
   if conDEBUG then Wscript.Echo ".Sender = " & objMessage.Sender
   if conDEBUG then Wscript.Echo "strdisplayName " & strdisplayName
   if conDEBUG then Wscript.Echo "bolSender = " & bolSender
   if bolDSTappoint then 
    if objMessage.IsRecurring then 
     numAppointRecur = numAppointRecur + 1
    else
     numAppointSingle = numAppointSingle + 1
    end if
    if bolSender then numApptointSender  = numApptointSender + 1
   end if
  Next
  Set objSession = Nothing  
 end if ' bolMailboxRights
 if (numAppointRecur + numAppointSingle) > 0 then   
  wscript.Echo strUser & ";" & strdisplayName & ";" & numAppointRecur & ";" & numAppointSingle & ";" & numApptointSender
  numUserWithAppointCount = numUserWithAppointCount + 1
 end if
 
 rs.MoveNext

Loop

Wscript.Echo "numUserCount = " & numUserCount
Wscript.Echo "numUserWithAppointCount = " & numUserWithAppointCount