使用VB脚本和联系人组向Outlook中的多个联系人发送电子邮件

Question

我正尝试向日历事件上的联系人组发送电子邮件通知。

要做到这一点，我使用类别，例如Send Message类别，这将发送电子邮件到指定的联系人组。

我的VB代码如下：

Private Sub Application_Reminder(ByVal Item As Object) 
Dim objMsg As MailItem 

Set objMsg = Application.CreateItem(olMailItem) 

Select Case Item.Categories 
Case "Send Message" 

Set objGroup = GetObject _ 
("LDAP://cn=Scientists,ou=R&D,dc=NA,dc=fabrikam,dc=com") 

objGroup.GetInfo 

arrMemberOf = objGroup.GetEx("Test") 

For Each strMember In arrMemberOf 
    Set objUser = GetObject("LDAP://" & strMember) 
    strEmail = Replace(objUser.mail, "@", "@internal.") 
    emailList = emailList & strEmail & ";" 
Next 

strTo = emailList 

objMsg.To = strTo 
objMsg.Subject = "BI Test" 
    objMsg.Body = "This is a test" 

我不太知道如何设置的LDAP参数，我是新来这。

在此先感谢。

Answer 1

我已经想通了，见下图：

Private Sub Application_Reminder(ByVal Item As Object) 
Dim objMsg As MailItem 
Dim Conn 
Dim cmd 
Dim ToStrn 

Set objMsg = Application.CreateItem(olMailItem) 
Set Conn = CreateObject("ADODB.Connection") 
Conn.ConnectionString = "driver={SQL Server}; server=localhost;user id = sa; password=mypass; Initial Catalog=TestDatabase" 
Conn.Open 

Select Case Item.Categories 
Case "Send Message" 

Set Rs = CreateObject("ADODB.recordset") 
Rs.Open "Select * from Cleints where Rank = 'MNGR'", Conn 
While Not Rs.EOF 
    ToStrn = ToStrn + CStr(Rs.Fields.Item("Email")) + "; " 
    Rs.MoveNext 
Wend 

objMsg.To = ToStrn 
objMsg.Subject = "SQL Test" 
objMsg.Body = "This is a test message sent via a calender event."