收到新电子邮件时,向Outlook通讯录中的所有联系人发送电子邮件(VB)

时间:2015-02-24 13:19:56

标签: vba outlook outlook-2007

我想编写一个VBA脚本,当Outlook从特定电子邮件地址收到新电子邮件时,VBA脚本必须检测到该邮件并将新收到的电子邮件重新发送给通讯簿中的所有联系人。

现在,我可以向地址簿中的所有联系人发送电子邮件:

Sub SendEmails()
Dim ContactsFolder As Folder
Set ContactsFolder = Session.GetDefaultFolder(olFolderContacts)
Dim Contact As Object
Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem
Set olApp = Outlook.Application

For Each Contact In ContactsFolder.Items
    Set objMail = olApp.CreateItem(olMailItem)
    With objMail
        .Subject = "Subject of the received email"
        .Body = "Body of the received email"
        .To = Contact.Email1Address
        .Send
    End With
Next
End Sub

但是如何使用此脚本,以便在从特定电子邮件地址收到新电子邮件时调用。

我试图把它放在ThisOulookSeassion中来检查新的消息事件,这样我就可以在其中调用上面的代码:

Private Sub Application_NewMail()
MsgBox "New mail"
End Sub

但它没有用。

我也试过这个(我也把它放在ThisOulookSeassion中):

Private WithEvents Items As Outlook.Items 
Private Sub Application_Startup() 
Dim olApp As Outlook.Application 
Dim objNS As Outlook.NameSpace 
Set olApp = Outlook.Application 
Set objNS = olApp.GetNamespace("MAPI") 
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items 
 End Sub
  Private Sub Items_ItemAdd(ByVal item As Object) 

 On Error Goto ErrorHandler 
Dim Msg As Outlook.MailItem 
 If TypeName(item) = "MailItem" Then
   Set Msg = item 
   ' ******************
   ' and placing my code here.
   ' ******************
   End If
 ProgramExit: 
  Exit Sub
 ErrorHandler: 
   MsgBox Err.Number & " - " & Err.Description 
  Resume ProgramExit 
 End Sub

但是当我点击运行时,它要求我创建新的宏并且不要运行代码。

有什么建议吗?

1 个答案:

答案 0 :(得分:1)

最简单的方法是在Outlook中创建规则。然后,您可以分配现有VBA宏以在运行规则时运行。通常,VBA sub应该如下所示:

 Sub SendEmails(mail as MailItem)
   Dim ContactsFolder As Folder
   Set ContactsFolder = Session.GetDefaultFolder(olFolderContacts)
   Dim objMail as MailItem
   Dim Contact As Object

   For Each Contact In ContactsFolder.Items
      Set objMail = olApp.CreateItem(olMailItem)
      With objMail
        .Subject = mail.Subject
        .Body = "Body Text"
        .To = Contact.Email1Address
        .Send
      End With
   Next
 End Sub

您也可以考虑将收件人添加到“收件人”集合,并将其Type设置为 olBCC 值。因此,他们每个人都会收到一封单独的电子邮件,您只需要提交一个邮件。