VBA从Excel检测Outlook传入的电子邮件

Question

我试图使用链接中列出的代码来检测来自Excel宏的新Outlook电子邮件。 到目前为止，这段代码对我不起作用。 我不确定为什么。 我也不太确定需要什么来进入类模块，常规模块或如何调用它才能进行监视。 我不想按照文章中的建议将其添加到Outlook中，因为当我可以简单地发送一个excel文件并引用他们的Outlook时，我无法将其物理地添加到所有需要使用的个人中。 我试图了解在捕获Outlook事件时事件如何工作，任何帮助将不胜感激。 谢谢。

Sub WorkWithNewMail() 
Dim objOutlook As Outlook.ApplicationDim objAllNewMail As Outlook.Items
Dim objMyEmail As Outlook.MailItem
Set objOutlook = New Outlook.Application
Set objAllNewMail = objOutlook.NewMail
   For Each objMyEmail In objAllNewMail
     'Do something with every email received
   Next
End Sub

Option Explicit
Private objNS As Outlook.NameSpace
Private WithEvents objNewMailItems As Outlook.Items

Private Sub objNewMailItems_ItemAdd(ByVal Item As Object)
Dim objEmail As Outlook.MailItem
'Ensure we are only working with e-mail items
If Item.Class<> OlItemType.olMailItem Then Exit Sub 
Debug.Print "Message subject: " & objEmail.Subject
Debug.Print "Message sender: " & objEmail.SenderName &" (" &objEmail.SenderEmailAddress & ")";
Set objEmail = Nothing
End Sub

Answer 1

您误解了这篇文章。 关键点是“不幸的是，没有神奇的NewMail集合”。

工作代码在本文的后半部分。 它是针对Outlook而不是Excel，但您仍然可以得到想要的东西。

首先在您自己的收件箱中尝试此操作，以查看添加邮件项时它是否正常工作。

注意未经测试的代码。 我可能稍后再测试。

在ThisOutlookSession模块中

Option Explicit

Private WithEvents objNewMailItems As Items

Private Sub Application_Startup()

dim objNS as namespace
Dim objMyInbox As Folder

Set objNS = GetNamespace("MAPI")

' This references your inbox. 
Set objMyInbox = objNS.GetDefaultFolder(olFolderInbox)

Set objNewMailItems = objMyInbox.Items

Set objNS = Nothing
Set objMyInbox = Nothing
End Sub

Private Sub objNewMailItems_ItemAdd(ByVal Item As Object)
'Ensure we are only working with e-mail items
If Item.Class<> olMail Then Exit Sub
Debug.Print "Message subject: " & Item.Subject
Debug.Print "Message sender: " & Item.SenderName & _
  " (" & Item.SenderEmailAddress & ")"
End Sub

回复：“当我可以简单地发送一个excel文件并引用其前景时。” 如果您被授予权限，则可以参考此处所述引用其他人的收件箱。

使用共享文件夹（Exchange邮箱）

dim objNS as namespace
Dim objOwner As Recipient
Set objNS = GetNamespace("MAPI")
Set objOwner = objNS.CreateRecipient("name , alias or email address")
objOwner.Resolve

If objOwner.Resolved Then
    'MsgBox objOwner.Name
    Set objOwnerInbox = objNS.GetSharedDefaultFolder(objOwner, olFolderInbox)
End If

全部放在一起

再次在您自己的ThisOutlookSession模块中

替换原始的Application_Startup代码

Option Explicit

Private WithEvents objOwnerInboxItems As Outlook.Items

Private Sub Application_Startup()

    dim objNS as namespace
    Dim objOwner As Recipient
    Dim objOwnerInbox As Folder

    Set objNS = GetNamespace("MAPI")

    ' As described in the article
    ' You can use the mailbox owner's display name, alias, or email address when resolving the recipient. 
    Set objOwner = objNS.CreateRecipient("name , alias or email address")
    objOwner.Resolve

    If objOwner.Resolved Then
        'MsgBox objOwner.Name
        ' If the owner has given you permission
        Set objOwnerInbox = objNS.GetSharedDefaultFolder(objOwner, olFolderInbox)
        Set objOwnerInboxItems = objOwnerInbox.Items
    End if

    Set objNS = Nothing
    Set objOwner = Nothing
    Set objOwnerInbox = Nothing

End Sub

Private Sub objOwnerInboxItems_ItemAdd(ByVal Item As Object)
    'Ensure we are only working with e-mail items
    If Item.Class<> olMail Then Exit Sub
    Debug.Print "Message subject: " & Item.Subject
    Debug.Print "Message sender: " & Item.SenderName & _
      " (" & item.SenderEmailAddress & ")"
End Sub