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

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

Send email to all contacts in Outlook address book when a new email received (VB)

vba

outlook

outlook-2007