如何在我的辅助邮件帐户中获取有关新邮件的信息？答案

【问题标题】：How to get info about the new message in my secondary mail account?如何在我的辅助邮件帐户中获取有关新邮件的信息？
【发布时间】：2020-02-04 11:40:42
【问题描述】：

outlook 中有几个邮件帐户。

有一个代码可以生成一个消息框，其中包含主邮箱中新邮件的属性。它适用于我的主要邮件帐户。

Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
  Dim outlookApp As Outlook.Application
  Dim objectNS As Outlook.NameSpace

  Set outlookApp = Outlook.Application
  Set objectNS = outlookApp.GetNamespace("MAPI")


  Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim MessageInfo
Dim Result
If TypeName(Item) = "MailItem" Then
    MessageInfo = "" & _
        "Sender : " & Item.SenderEmailAddress & vbCrLf & _
        "Sent : " & Item.SentOn & vbCrLf & _
        "Received : " & Item.ReceivedTime & vbCrLf & _
        "Subject : " & Item.Subject & vbCrLf & _
        "Size : " & Item.Size & vbCrLf & _
        "Message Body : " & vbCrLf & Item.Body
    Result = MsgBox(MessageInfo, vbOKOnly, "New Message Received")
End If
ExitNewItem:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ExitNewItem
End Sub

弹出消息如下所示：

还有另一个邮箱“规格估计 RU41”。我的任务是为该邮箱的新传入邮件获取相同的弹出消息。我换了行

Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items

与

Set inboxItems = objectNS.Folders("Specification Estimation RU41") _
                    .Folders("Inbox").Items

所以整个代码看起来像这样：

Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
  Dim outlookApp As Outlook.Application
  Dim objectNS As Outlook.NameSpace

  Set outlookApp = Outlook.Application
  Set objectNS = outlookApp.GetNamespace("MAPI")
 Set inboxItems = objectNS.Folders("Specification Estimation RU41") _
                    .Folders("Inbox").Items


End Sub
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim MessageInfo
Dim Result
If TypeName(Item) = "MailItem" Then
    MessageInfo = "" & _
        "Sender : " & Item.SenderEmailAddress & vbCrLf & _
        "Sent : " & Item.SentOn & vbCrLf & _
        "Received : " & Item.ReceivedTime & vbCrLf & _
        "Subject : " & Item.Subject & vbCrLf & _
        "Size : " & Item.Size & vbCrLf & _
        "Message Body : " & vbCrLf & Item.Body
    Result = MsgBox(MessageInfo, vbOKOnly, "New Message Received")
End If
ExitNewItem:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ExitNewItem
End Sub

但这不起作用。没有错误消息，但对新邮件没有反应。

我怎样才能让它工作？

【问题讨论】：

您对第二个文件夹有权限吗？您可以尝试使用 VBA 在该文件夹中创建一些内容以进行检查。
@DavidG 是的，我有权限。代码在 ThisOutlookSession 中。我怎样才能做到这一点？我的意思是用 VBA 在这个文件夹中创建一些东西。
单步执行代码时，您确定 inboxItems 变量不是 Nothing？
@DmitryStreblechenko 不，这不是什么。它显示所有收件箱项目。 screenshot .

标签： vba outlook

【解决方案1】：

您是否尝试过使用NameSpace.GetSharedDefaultFolder method (Outlook) MSDN

此方法用于委托场景，其中一个用户已将一个或多个默认文件夹的访问权限委托给另一个用户

例子

Private WithEvents RU41_Items As Outlook.Items

Private Sub Application_Startup()
    Dim olNs As Outlook.NameSpace
    Set olNs = Application.GetNamespace("MAPI")

    Dim RU41_Recip As Outlook.Recipient
    Set RU41_Recip = olNs.CreateRecipient("0m3r@email.com")

    Dim RU41_Inbox As Outlook.MAPIFolder
    Set RU41_Inbox = olNs.GetSharedDefaultFolder(RU41_Recip, olFolderInbox)

    Set RU41_Items = RU41_Inbox.Items

End Sub

Private Sub RU41_Items_ItemAdd(ByVal Item As Object)
    If TypeOf Item Is Outlook.MailItem Then
        DoEvents
        '''code here
    End If
End Sub

【讨论】：