用于检查共享 Exchange 日历并发送电子邮件详细信息的脚本

用于检查共享 Exchange 日历并发送电子邮件详细信息的脚本

我们在这里运行 Server 和 Exchange 2003。

有一个共享日历,HR 会不断更新休假员工的详细信息。我正在寻找一个 VB 脚本(或替代脚本),该脚本将提取当天每项的“约会”标题,然后将详细信息通过电子邮件发送给邮件组,这样就可以通知该组当天哪些员工休假。

最终的电子邮件正文应为:


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


@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

年代

答案1

您可以使用协作数据对象 (CDO) 库来实现这一点。它们并不难使用。请查看此样本。本质上,您需要使用具有适当权限的用户打开日历文件夹,获取当天的约会,并对其进行迭代。

相关内容