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

时间:2013-08-29 06:35:30

标签: vbscript outlook outlook-addin outlook-vba

我正在尝试向日历活动的联系人群组发送电子邮件通知。

要执行此操作,我使用的是类别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参数,我是新手。

提前致谢。

1 个答案:

答案 0 :(得分:0)

我已经弄清楚了,见下文:

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."