CODEWITHSUNDEEP
vbaoutlook
Sergey Belousov
Sergey Belousov

Reputation: 153

How to get info about the new message in my secondary mail account?

There are several mail accounts in outlook.

There is a code, that generates a message box with the properties of the new mail in the primary mailbox. It works for my primary mail account.

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

Here is what the pop-up message looks like: Here is what the pop-up message looks like

There is another mailbox "Specification Estimation RU41". My task is to get the same pop-up message for new incoming mail to this mailbox. I replaced the line 

Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items

with

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

so that whole code looks like this:

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

But this doesn't work. No error messages, but no reaction at the new mails.

How can I make it work?

Upvotes: 1

Views: 150

Answers (1)

0m3r
0m3r

Reputation: 12495

Have you tried working with NameSpace.GetSharedDefaultFolder method (Outlook) MSDN

This method is used in a delegation scenario, where one user has delegated access to another user for one or more of their default folders

Example

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("[email protected]")

    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

Upvotes: 2

Related Questions