VBA检测来自Excel

时间:2015-06-03 17:11:38

标签: excel vba excel-vba outlook

我尝试使用链接中列出的代码从excel宏中检测新的Outlook电子邮件。 This code has not worked for me so far.我不确定为什么。我也不太确定需要进入类模块,常规模块或如何调用它以便进行监视。我不想按照文章中的建议将其添加到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

1 个答案:

答案 0 :(得分:1)

你误解了这篇文章。关键点是“不幸的是,没有神奇的NewMail系列”。

工作代码位于本文的后半部分。这是Outlook而不是Excel,但你可以得到你想要的东西。

首先在您自己的收件箱中试用,以便在添加mailitem时看到它正常工作。

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

在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

Re:“当我可以简单地发送一个excel文件并引用他们的前景时。” 如果您已获得许可,则按照此处所述引用其他人的收件箱。

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

把这一切放在一起

再一次在你自己的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