收到新电子邮件时发送电子邮件给Outlook通讯簿中的所有联系人（VB）

Question

我想写一个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 

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

有什么建议吗？

Answer 1

最简单的方法是在Outlook中创建规则。然后，您可以分配一个现有的VBA宏，以在规则运行时运行。通常，VBA子谨下列之一：

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值。因此，他们每个人都会收到一封单独的电子邮件，而您只需提交一封邮件。