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