CODEWITHSUNDEEP
vbaoutlookoutlook-2016
Planner
Planner

Reputation: 11

How to reference a non-default account?

I am trying to modify code from How to move each emails from inbox to a sub-folder posted by 0m3r.

Option Explicit
Public Sub Move_Items()
'   // Declare your Variables
    Dim Inbox As Outlook.MAPIFolder
    Dim SubFolder As Outlook.MAPIFolder
    Dim olNs As Outlook.NameSpace
    Dim Item As Object
    Dim lngCount As Long
    Dim Items As Outlook.Items

    On Error GoTo MsgErr
'    Set Inbox Reference
    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set Items = Inbox.Items

'   // Loop through the Items in the folder backwards
    For lngCount = Items.Count To 1 Step -1
        Set Item = Items(lngCount)

        Debug.Print Item.Subject

        If Item.Class = olMail Then
'           // Set SubFolder of Inbox
            Set SubFolder = Inbox.Folders("Temp")
'           // Mark As Read
            Item.UnRead = False
'           // Move Mail Item to sub Folder
            Item.Move SubFolder
        End If
    Next lngCount

MsgErr_Exit:
    Set Inbox = Nothing
    Set SubFolder = Nothing
    Set olNs = Nothing
    Set Item = Nothing

    Exit Sub

'// Error information
MsgErr:
    MsgBox "An unexpected Error has occurred." _
         & vbCrLf & "Error Number: " & Err.Number _
         & vbCrLf & "Error Description: " & Err.Description _
         , vbCritical, "Error!"
    Resume MsgErr_Exit
End Sub

This code works with an Outlook profile that has one email account.

In my case, MS Outlook I use has two email accounts. I need to collect emails from the second account ([email protected]), which is not default.

I modified the line:

Set olNs = Application.GetNamespace("MAPI")

To:

Set olNs = Application.GetNamespace("MAPI").Folders("[email protected]")

I get an error message

An unexpected Error has occurred. Error number: 13. Error Description: Type mismatch

I use MS Outlook 2016 (x64).

Upvotes: 1

Views: 124

Answers (1)

Eugene Astafiev
Eugene Astafiev

Reputation: 49397

In the code you deal with a default Inbox folder by using the following code for retrieving it:

Set Inbox = olNs.GetDefaultFolder(olFolderInbox)

If you need to get the Inbox folder from other accounts configured in Outlook you need to use the Store.GetDefaultFolder method which returns a Folder object that represents the default folder in the store and that is of the type specified by the FolderType argument. This method is similar to the GetDefaultFolder method of the NameSpace object. The difference is that this method gets the default folder on the delivery store that is associated with the account, whereas NameSpace.GetDefaultFolder returns the default folder on the default store for the current profile.

So, you need to iterate over all Stores in the profile and process each Inbox separately. The NameSpace.Stores property returns a Stores collection object that represents all the Store objects in the current profile. For example:

Sub EnumerateFoldersInStores()  
 Dim colStores As Outlook.Stores  
 Dim oStore As Outlook.Store 
 Dim oInbox As Outlook.Folder  
 Dim Item As Object
 Dim lngCount As Long
 Dim Items As Outlook.Items
 
 On Error Resume Next 
 
 Set colStores = Application.Session.Stores 
 
 For Each oStore In colStores 
   Set oInbox = oStore.GetDefaultFolder(olFolderInbox)
   Debug.Print (oRoot.FolderPath) 
 
   Set Items = Inbox.Items
   ' Set SubFolder of Inbox
   Set SubFolder = Inbox.Folders("Temp")
   
   ' Loop through the Items in the folder backwards
   For lngCount = Items.Count To 1 Step -1
        Set Item = Items(lngCount)

        Debug.Print Item.Subject

        If Item.Class = olMail The
          ' Mark As Read
          Item.UnRead = False
          ' Move Mail Item to sub Folder
          Item.Move SubFolder
        End If
    Next lngCount

 Next 
 
End Sub

And the last bit - it is better to declare the target folder out of the loop where you iterate over all items.

Upvotes: 0

Related Questions