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

Question

I have tried to use the code listed in the link to detect a new outlook email from an excel macro. This code has not worked for me so far. I am not sure as to why. I am also not quite sure what needs to go into a class module, regular module or how to call it in order for it to be monitoring. I dont want to add this to outlook as suggested in the article, because I can not physically added it to all individuals who need to use, when I can simply send an excel file and reference their outlook. I am trying to understand how with events works when capturing the outlook event and any help would be greatly appreciated. Thank you.

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

You misunderstood the article. The key point was "Unfortunately, there is no magical NewMail collection".

The working code is in the latter part of the article. It is for Outlook not Excel, yet you may be able to get what you want.

Try this first on your own Inbox, to see it working when a mailitem is added.

Note untested code. I may test later.

In the ThisOutlookSession module

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

Re: "when I can simply send an excel file and reference their outlook." If you have been given permission, you reference someone else's inbox as described here.

Use a shared folder (Exchange mailbox)

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

Putting this all together

Once again in your own ThisOutlookSession module

Replace the original Application_Startup code

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