Script to check a shared Exchange calendar and then email detail
- by SJN
We're running Server and Exchange 2003 here.
There's a shared calendar which HR keep up-to-date detailing staff who are on leave. I'm looking for a VB Script (or alternate) which will extract the "appointment" titles of each item for the current day and then email the detail to a mail group, in doing so notifying the group with regard to which staff are on leave for the day.
The resulting email body should be:
Staff on leave today:
Mike Davis
James Stead
@Paul Robichaux - ADO is the way I went for this in the end, here are the key component for those interested:
Dim Rs, Conn, Url, Username, Password, Recipient
Set Rs = CreateObject("ADODB.Recordset")
Set Conn = CreateObject("ADODB.Connection")
'Configurable variables
Username = "Domain\username" ' AD domain\username
Password = "password" ' AD password
Url = "file://./backofficestorage/domain.com/MBX/username/Calendar" 'path to user's mailbox and folder
Recipient = "[email protected]"
Conn.Provider = "ExOLEDB.DataSource"
Conn.Open Url, Username, Password
Set Rs.ActiveConnection = Conn
Rs.Source = "SELECT ""DAV:href"", " & _
" ""urn:schemas:httpmail:subject"", " & _
" ""urn:schemas:calendar:dtstart"", " & _
" ""urn:schemas:calendar:dtend"" " & _
"FROM scope('shallow traversal of """"') "
Rs.Open
Rs.MoveFirst
strOutput = ""
Do Until Rs.EOF
If DateDiff("s", Rs.Fields("urn:schemas:calendar:dtstart"), date) >= 0 And DateDiff("s", Rs.Fields("urn:schemas:calendar:dtend"), date) < 0 Then
strOutput = strOutput & "<p><font size='2' color='black' face='verdana'><b>" & Rs.Fields("urn:schemas:httpmail:subject") & "</b><br />" & vbCrLf
strOutput = strOutput & "<b>From: </b>" & Rs.Fields("urn:schemas:calendar:dtstart") & vbCrLf
strOutput = strOutput & " <b>To: </b>" & Rs.Fields("urn:schemas:calendar:dtend") & "<br /><br />" & vbCrLf
End If
Rs.MoveNext
Loop
Conn.Close
Set Conn = Nothing
Set Rec = Nothing
After that, you can do what you like with srtOutput, I happened to use CDO to send an email:
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Subject"
objMessage.From = "[email protected]"
objMessage.To = Recipient
objMessage.HTMLBody = strOutput
objMessage.Send
S
