Script to check a shared Exchange calendar and then email detail

Posted by SJN on Server Fault See other posts from Server Fault or by SJN
Published on 2009-12-11T11:17:38Z Indexed on 2012/04/01 5:31 UTC
Read the original article Hit count: 230

Filed under:
|
|

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 & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<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

© Server Fault or respective owner

Related posts about exchange

Related posts about scripting