Accessing another maibox in outlook using vba

Question

Hey! I have two mailboxes in my Outlook.

One that is mine and it automatically logs me in when I log in to my pc and another I have that is for mail bounces.

I really need to access the inbox of the mail's account but I just can't seem to do it.

And there is no way I can make the mailbox of the mail account to be my default mailbox

Here is the code I have so far:

Public Sub GetMails()

    Dim ns As NameSpace
    Dim myRecipient As Outlook.Recipient
    Dim aFolder As Outlook.Folders

    Set ns = GetNamespace("MAPI")

    Set myRecipient = ns.CreateRecipient("[email protected]")
    myRecipient.Resolve
    If myRecipient.Resolved Then
        MsgBox ("Resolved")
        Set aFolder = ns.GetSharedDefaultFolder(myRecipient, olFolderInbox)
    Else
        MsgBox ("Failed")
    End If

End Sub

The problem I am getting is at the 'Set aFolder = ns.GetSharedDefaultFolder(myRecipient, olFolderInbox)'

I get the Resolved msgbox so I know that is working but after that I get a 'Run-Time error' which doesn't say much about the error itself.

Can anyone help me out here please? Thanks

Answer 1

If the folder you wish to access is not an Exchange folder, you will need to find it, if it is an Exchange folder, try logging on to the namespace.

Log on to NameSpace

  Set oNS = oApp.GetNamespace("MAPI")
  oNS.Logon

Find Folder As far as I recall, this code is from Sue Mosher.

Public Function GetFolder(strFolderPath As String) As Object 'MAPIFolder
' strFolderPath needs to be something like
'   "Public Folders\All Public Folders\Company\Sales" or
'   "Personal Folders\Inbox\My Folder" ''

Dim apOL As Object 'Outlook.Application '
Dim objNS As Object 'Outlook.NameSpace '
Dim colFolders As Object 'Outlook.Folders '
Dim objFolder As Object 'Outlook.MAPIFolder '
Dim arrFolders() As String
Dim I As Long

On Error GoTo TrapError

    strFolderPath = Replace(strFolderPath, "/", "\")

'

    arrFolders() = Split(strFolderPath, "\")

'

    Set apOL = CreateObject("Outlook.Application")
    Set objNS = apOL.GetNamespace("MAPI")


    On Error Resume Next

    Set objFolder = objNS.Folders.Item(arrFolders(0))

    If Not objFolder Is Nothing Then
        For I = 1 To UBound(arrFolders)
            Set colFolders = objFolder.Folders
            Set objFolder = Nothing
            Set objFolder = colFolders.Item(arrFolders(I))

            If objFolder Is Nothing Then
                Exit For
            End If
        Next
    End If

    Set GetFolder = objFolder
    Set colFolders = Nothing
    Set objNS = Nothing
    Set apOL = Nothing


End Function