Thursday, February 22, 2007

Creating a Report of Meeting Organizers for all appointments in all calendars on a Server via WebDAV

Euricelia Wanderley created the following script to do some reporting on User's meeting that fell withing the affected US DST period .Euricelia script uses some webDAV to do a expansion query of all calendar appointments in the affected period and then produces a csv of the results. The script uses a few cool tricks like parsing out the organizer of the meeting from the vcalendar stream of the appointment. I've taken this idea a little further and put together a version of the same type of thing that designed to send the user a HTML summary email that shows them all the appointments within the affected period im still working on this at the moment having a few issues linking to Exceptions of recurring appointments should kick it tommorow.

I've put a downloadable copy of Euricelia script here the script itself looks like

on error resume next
servername = "SERVERNAME"
public username
public password
username = "USERNAME"
password = "PASSWORD"
public datefrom
public dateto
datefrom = "2007-03-11T00:00:00Z"
dateto = "2007-04-01T00:00:00Z"

set shell = createobject("")
set conn1 = createobject("ADODB.Connection")
Set fso = CreateObject("Scripting.FileSystemObject")
fname = "c:\support\scripts\" & servername & ".csv"
set wfile = fso.opentextfile(fname,2,true)

set conn = createobject("ADODB.Connection")
set com = createobject("ADODB.Command")
Set iAdRootDSE = GetObject("LDAP://RootDSE")
strNameingContext = iAdRootDSE.Get("configurationNamingContext")
strDefaultNamingContext = iAdRootDSE.Get("defaultNamingContext")
Conn.Provider = "ADsDSOObject"
Conn.Open "ADs Provider"
svcQuery = "<LDAP://" & strNameingContext &amp;amp;amp;amp; ">;(&(objectCategory=msExchExchangeServer)(cn="
& Servername & "));cn,name,legacyExchangeDN;subtree"
Com.ActiveConnection = Conn
Com.CommandText = svcQuery
Set Rs = Com.Execute
while not rs.eof
GALQueryFilter = "(&(&(&(&(mailnickname=*)(!msExchHideFromAddressLists=TRUE)((&(objectCategory=person)(objectClass=user)(msExchHomeServerName="
&rs.fields("legacyExchangeDN") &amp;amp;amp;amp; ")) )))))"
strQuery = "<LDAP://" & strDefaultNamingContext &amp;amp;amp;amp; ">;" & GALQueryFilter & ";distinguishedName,mail,displayname,mailnickname;subtree"
com.Properties("Page Size") = 100
Com.CommandText = strQuery
Set Rs1 = Com.Execute
while not Rs1.eof
wscript.echo "User: " & rs1.fields("displayname")
user = rs1.fields("mail")
call QueryAttendees(servername,user)
set conn = nothing
set com = nothing
wscript.echo "Done"

Public Sub QueryAttendees(server,mailbox)

On Error Resume Next

strURL = "http://" & server & "/exchange/" & mailbox & "/calendar/"
strQuery = "<?xml version=""1.0""?><D:searchrequest xmlns:D = ""DAV:"" >"
strQuery = strQuery & "<D:sql>SELECT DISTINCT ""DAV:href"" FROM scope('shallow
traversal of """ & strURL &amp;amp;amp;amp; """') "
strQuery = strQuery & " Where ""DAV:isfolder"" = false AND ""DAV:ishidden"" =
false AND ""urn:schemas:calendar:alldayevent"" = false "
strQuery = strQuery & "AND ""DAV:contentclass"" =
'urn:content-classes:appointment' "
strQuery = strQuery & "AND ""urn:schemas:calendar:dtend"" &amp;amp;amp;gt; CAST(""" &
datefrom & """ as '') "
strQuery = strQuery &amp; "AND ""urn:schemas:calendar:dtstart"" &lt; CAST(""" &
dateto & """ as '') "
strQuery = strQuery &amp; "</D:sql></D:searchrequest>"

wscript.echo strQuery
set req = createobject("microsoft.xmlhttp") "SEARCH", strURL, false, username, password

If Err.Number <> 0 Then
WScript.Echo "Error Opening Search"
WScript.Echo Err.Number & ": " & Err.Description
End If

req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
req.setRequestHeader "Depth", "1,noroot"
req.send strQuery

If Err.Number <> 0 Then
WScript.Echo "Error Sending Query"
WScript.Echo Err.Number & ": " & Err.Description
End If

wscript.echo req.status
wscript.echo "response" & req.responseXML

If req.status >= 500 Then
wscript.echo "Status: " & req.status
wscript.echo "Status text: An error occurred on the server."
ElseIf req.status = 207 Then
set oResponseDoc = req.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("a:href")
For i = 0 To (oNodeList.length -2)
set oNode = oNodeList.nextNode
wscript.echo "Status: " & req.status
wscript.echo "Status text: " & req.statustext
wscript.echo "Response text: " & req.responsetext
End If

End Sub

public sub proccalmess(objhref)

set req = createobject("microsoft.xmlhttp")
wscript.echo objhref
wfile.write(objhref & ",")
On Error Resume Next "GET", objhref, false,username, password
If Err.Number <> 0 Then
WScript.Echo "Error Opening GET"
WScript.Echo Err.Number & ": " & Err.Description
End If

Req.setRequestHeader "Translate","f"

attendeearry = split(req.responsetext,"ORGANIZER;",-1,1)
for i = 1 to ubound(attendeearry)
string1 = vbcrlf & " "
stparse = replace(attendeearry(i),string1,"")
attaddress = mid(stparse,(instr(stparse,"MAILTO:")+7),instr(stparse,chr(13)))
attaddress = mid(attaddress,1,instr(attaddress,vbcrlf))
wscript.echo attaddress

end sub

1 comment:

Anonymous said...

This momentousdecree warcraft leveling came as a great beacon light wow lvl of hope to millions of negroslaves wow power level who had been seared power leveling in the flames of power leveling withering wrath of the lich king power leveling injustice.wrath of the lich king power leveling it came as a WOTLK Power Leveling joyous daybreak to end the long WOTLK Power Leveling night ofcaptivity.WOTLK Power Leveling but one hundred years wlk power leveling later, we must face aoc gold the tragic fact thatthe age of conan power leveling negro is still not free. aoc power leveling one hundred years later,age of conan power leveling the lifeof the negro ffxi gil is still sadly crippled by the final fantasy xi gil manacles ofsegregation guild wars gold and the chains of discrimination. one hundred yearslater, maplestory mesos the negro lives on a lonely island of poverty in themidst of a vast ocean of material clothes one hundred yearslater