收到新电子邮件时向 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

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