脚本检查共享的Exchange日历，然后发送电子邮件详细信息

我们在这里运行服务器和Exchange 2003。

有一个共享的日历，人力资源保持最新详细说明正在休假的员工。 我正在寻找一个VB脚本（或备用），它将提取当天每个项目的“约会”标题，然后通过电子邮件将详细信息发送给一个邮件组，以通知小组关于哪些员工离开一天。

由此产生的电子邮件正文应为：

今天休假的员工：Mike Davis James Stead

• Iomega NAS ix2-200 RAID模式的问题？
• 安装Exchange 2003的域别名
• Outlook HTTP Exchange连接到Exchange 2007
• 将Exchange 2000邮箱从旧域移动到新域中的Exchange 2007
• Exchange 2003自动邮箱大小报告

@Paul Robichaux – ADO是我到最后的方式，这里是有兴趣的人的关键组成部分：

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 

在那之后，你可以用srtOutput来做你喜欢的事情，我碰巧用CDO发送一封邮件：

 Set objMessage = CreateObject("CDO.Message") objMessage.Subject = "Subject" objMessage.From = "[email protected]" objMessage.To = Recipient objMessage.HTMLBody = strOutput objMessage.Send 

小号