Option Explicit
' Variables.
Dim strCalendarURI ' As String
Dim reqDoc ' As Msxml2.DOMDocument
Dim resDoc ' As Msxml2.DOMDocument
Dim pi ' As IXMLDOMProcessingInstruction
Dim strPassword ' As String
Dim strUserName ' As String
Dim searchrequestNode ' As IXMLDOMNode
Dim sqlNode ' As IXMLDOMNode
Dim strQuery ' As String
Dim queryNode ' As IXMLDOMText
Dim req ' As MSXML2.XMLHTTP
Dim objSubjectNodeList ' As IXMLDOMNodeList
Dim objLocationNodeList ' As IXMLDOMNodeList
Dim objuidNodeList ' As IXMLDOMNodeList
Dim objStartTimeNodeList ' As IXMLDOMNodeList
Dim objEndTimeNodeList ' As IXMLDOMNodeList
Dim objFacilityNodeList ' As IXMLDOMNodeList
Dim objdtstampNodeList ' As IXMLDOMNodeList
Dim objBusyStatusNodeList ' As IXMLDOMNodeList
Dim objInstanceTypeNodeList ' As IXMLDOMNodeList
Dim objtextdescriptionNodeList ' As IXMLDOMNodeList
Dim objNode ' As IXMLDOMNode
Dim i ' As Integer
Dim strInstanceType ' As String
Dim objFileSystem, objOutputFile
Dim strOutputFile
Dim MyTimeStart1
Dim MyTimeStart2
Dim MyTimeStart3
Dim MyTimeEnd1
Dim MyTimeEnd2
Dim MyTimeEnd3
Dim TimeCriteria1
Dim TimeCriteria2
' Initialize variables.
TimeCriteria1 = now
TimeCriteria2 = "'" & mid (formatDateTime (TimeCriteria1, 2),7,4) & "/" & mid (formatDateTime (TimeCriteria1, 2),4,2) & "/" & mid (formatDateTime (TimeCriteria1, 2),1,2) & " " & mid (formatDateTime (TimeCriteria1, 4), 1,5) & ":00'"
strUserName = "blabla"
strPassword = "blabla"
strCalendarURI = "[URL unfurl="true"]https://outlook/exchange/soscmissiongcsupport/calendar/"[/URL]
set reqDoc = createobject("microsoft.xmldom")
set resDoc = createobject("microsoft.xmldom")
set pi = reqDoc.createProcessingInstruction("xml","version=""1.0""")
' Append processing instruction node to the DOM document.
reqDoc.appendChild pi
' Create the DAV:searchrequest node and set it
' to the root element of the document.
set searchrequestNode = reqDoc.createNode(1,"searchrequest","DAV:")
set reqDoc.documentElement = searchrequestNode
' Create the DAV:sql node and append it to the root element.
set sqlNode = reqDoc.createNode(1,"sql","DAV:")
searchrequestNode.appendChild sqlNode
' Build the SQL query.
strQuery = "SELECT ""urn:schemas:calendar:location"", ""urn:schemas:httpmail:subject"", "
strQuery = strQuery & " ""urn:schemas:calendar:dtstart"", ""urn:schemas:calendar:uid"", "
strQuery = strQuery & " ""urn:schemas-microsoft-com:forms#Facility"", ""urn:schemas:calendar:dtstamp"", "
strQuery = strQuery & " ""urn:schemas:calendar:dtend"", ""urn:schemas:httpmail:textdescription"", "
strQuery = strQuery & " ""urn:schemas:calendar:busystatus"", ""urn:schemas:calendar:instancetype"" "
strQuery = strQuery & " FROM Scope('SHALLOW TRAVERSAL OF """ & strCalendarURI & """') "
strQuery = strQuery & "WHERE NOT ""urn:schemas:calendar:instancetype"" = 1 "
strQuery = strQuery & "AND ""DAV:contentclass"" = 'urn:content-classes:appointment' "
strQuery = strQuery & "AND ""urn:schemas:calendar:dtend"" > " & " " & TimeCriteria2
strQuery = strQuery & "ORDER BY ""urn:schemas:calendar:dtstart"" ASC"
' Create the SQL query textnode and append it to document.
set queryNode = reqDoc.createTextNode(strQuery)
sqlNode.appendChild queryNode
' Create the XMLHTTP object.
set req = createobject("msxml2.xmlhttp")
' Specify the SEARCH method, the URL, that the request will be sent synchronously,
' the user name, and the password.
req.open "SEARCH", strCalendarURI, false, strUserName, strPassword
' Set the Content-Type header to "text/xml".
req.setrequestheader "Content-Type", "text/xml"
' Send the SEARCH request.
req.send reqDoc
' An error occurred on the server.
If req.status >= 500 Then
'Display request status and status text.
msgbox "Status: " & req.status
msgbox "Status text: An error occurred on the server."
' Success. Display the item display names.
ElseIf req.status = 207 Then
' Display request status and status text.
' Get the XML response.
set resDoc = req.responseXML
' Build a list of the urn:schemas:httpmail:subject XML nodes,
' corresponding to the calendar item subjects returned in the search request.
' The urn:schemas:httpmail: namespace is typically
' assigned the e: prefix in the XML response body.
Set objSubjectNodeList = resDoc.getElementsByTagName("e:subject")
' Build a list of the urn:schemas:httpmail:textdescription XML nodes,
' corresponding to the calendar item descriptions returned in the search request.
' The urn:schemas:httpmail: namespace is typically
' assigned the e: prefix in the XML response body.
Set objtextdescriptionNodeList = resDoc.getElementsByTagName("e:textdescription")
' Build a list of the urn:schemas:calendar:location XML nodes,
' corresponding to the calendar item locations returned in the search request.
' The urn:schemas:calendar: namespace is typically
' assigned the d: prefix in the XML response body.
Set objLocationNodeList = resDoc.getElementsByTagName("d:location")
' Build a list of the urn:schemas:calendar:Facility XML nodes,
' corresponding to the calendar item Facility returned in the search request.
' The urn:schemas:calendar: namespace is typically
' assigned the d: prefix in the XML response body.
Set objFacilityNodeList = resDoc.getElementsByTagName("f:Facility")
' Build a list of the urn:schemas:calendar:dtstamp XML nodes,
' corresponding to the calendar item dtstamp returned in the search request.
' The urn:schemas:calendar: namespace is typically
' assigned the d: prefix in the XML response body.
Set objdtstampNodeList = resDoc.getElementsByTagName("d:dtstamp")
' Build a list of the urn:schemas:calendar:uid XML nodes,
' corresponding to the calendar item uids returned in the search request.
' The urn:schemas:calendar: namespace is typically
' assigned the d: prefix in the XML response body.
Set objuidNodeList = resDoc.getElementsByTagName("d:uid")
' Build a list of the urn:schemas:calendar:dtstart XML nodes,
' corresponding to the calendar item start times returned in the
' search request.
Set objStartTimeNodeList = resDoc.getElementsByTagName("d:dtstart")
' Build a list of the urn:schemas:calendar:dtend XML nodes,
' corresponding to the calendar item end times returned in the
' search request.
Set objEndTimeNodeList = resDoc.getElementsByTagName("d:dtend")
' Build a list of the urn:schemas:calendar:busystatus XML nodes,
' corresponding to the calendar item busy statuses returned in the
' search request.
Set objBusyStatusNodeList = resDoc.getElementsByTagName("d:busystatus")
' Build a list of the urn:schemas:calendar:instancetype XML nodes,
' corresponding to the calendar item instance types returned in the
' search request.
Set objInstancetypeNodeList = resDoc.getElementsByTagName("d:instancetype")
If objSubjectNodeList.length > 0 Then
' generate a filename base on the script name
strOutputFile = "C:\WebCal\" & "Calendar1.ics"
Set objFileSystem = CreateObject("Scripting.fileSystemObject")
Set objOutputFile = objFileSystem.CreateTextFile(strOutputFile, TRUE)
objOutputFile.WriteLine("BEGIN:VCALENDAR")
' Loop through returned calendar items.
For i = 0 To (objSubjectNodeList.length -1)
objOutputFile.WriteLine("BEGIN:VEVENT")
' Display subject.
Set objNode = objSubjectNodeList.nextNode
objOutputFile.WriteLine("SUMMARY:" & objNode.Text)
' Display description.
Set objNode = objtextdescriptionNodeList.nextNode
objOutputFile.WriteLine("DESCRIPTION:" & objNode.Text)
' Display location.
Set objNode = objLocationNodeList.nextNode
objOutputFile.WriteLine("LOCATION:" & objNode.Text)
' Display uid.
Set objNode = objuidNodeList.nextNode
objOutputFile.WriteLine("UID:" & objNode.Text)
'200 Display start time.
Set objNode = objStartTimeNodeList.nextNode
MyTimeStart1 = Mid(objNode.Text,9,2) & "/" & Mid(objNode.Text,6,2) & "/" & Mid(objNode.Text,1,4) & " " & Mid(objNode.Text,12,2) & ":" & Mid(objNode.Text,15,2) & ":00"
MyTimeStart2 = DateAdd("h", -4, MyTimeStart1)
MyTimeStart3 = mid (formatDateTime (MyTimeStart2, 2),7,4) & mid (formatDateTime (MyTimeStart2, 2),4,2) & mid (formatDateTime (MyTimeStart2, 2),1,2) & "T" & mid (formatDateTime (MyTimeStart2, 4), 1,2) & mid (formatDateTime (MyTimeStart2, 4), 4,2) & "00Z"
objOutputFile.WriteLine ("DTSTART:" & MyTimeStart3)
' Display end time.
Set objNode = objEndTimeNodeList.nextNode
MyTimeEnd1 = Mid(objNode.Text,9,2) & "/" & Mid(objNode.Text,6,2) & "/" & Mid(objNode.Text,1,4) & " " & Mid(objNode.Text,12,2) & ":" & Mid(objNode.Text,15,2) & ":00"
MyTimeEnd2 = DateAdd("H", -4, MyTimeEnd1)
MyTimeEnd3 = mid (formatDateTime (MyTimeEnd2, 2),7,4) & mid (formatDateTime (MyTimeEnd2, 2),4,2) & mid (formatDateTime (MyTimeEnd2, 2),1,2) & "T" & mid (formatDateTime (MyTimeEnd2, 4), 1,2) & mid (formatDateTime (MyTimeEnd2, 4), 4,2) & "00Z"
objOutputFile.WriteLine ("DTEND:" & MyTimeEnd3)
' Display Facility.
Set objNode = objFacilityNodeList.nextNode
objOutputFile.WriteLine("FACILITY:" & objNode.Text)
' Display dtstamp.
Set objNode = objdtstampNodeList.nextNode
objOutputFile.WriteLine("dtstamp:" & objNode.Text)
' Display busy status.
Set objNode = objBusyStatusNodeList.nextNode
objOutputFile.WriteLine("END:VEVENT")
Next
objOutputFile.WriteLine("END:VCALENDAR")
Else
strOutputFile = "C:\WebCal\" & "Calendar1.ics"
Set objFileSystem = CreateObject("Scripting.fileSystemObject")
Set objOutputFile = objFileSystem.CreateTextFile(strOutputFile, TRUE)
objOutputFile.WriteLine("BEGIN:VCALENDAR")
objOutputFile.WriteLine("END:VCALENDAR")
End If
Else
' Display the status, status text, and response text.
msgbox "Status: " & req.status
msgbox "Status text: " & req.statustext
msgbox "Response text: " & req.responsetext
End If
' Clean up.
Set req = nothing
objOutputFile.Close
Set objFileSystem = Nothing
WSCRIPT.QUIT(0)