我想编写一个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
但是当我点击运行时,它要求我创建新的宏并且不要运行代码。
有什么建议吗?
答案 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 值。因此,他们每个人都会收到一封单独的电子邮件,您只需要提交一个邮件。