Outlook Inbox-to-Folder Sortation Macro for Non-Default Inbox

Question

I am trying to, in VBA for Outlook 2013, sort any mail with a certain number format in the subject into corresponding folders. If the folder does not exist (if the strings in the subject and folder don't match), the folder is created. I need this macro to handle a non-default inbox. The following links are where I got the original code, which is spliced together at the bottom. I'm getting a run time error (-2147221233 (8004010f)) on line:

Set objProjectFolder = objDestinationFolder.Folders(folderName)

http://joelslowik.blogspot.com/2011/04/sort-emails-in-outlook-using-macro-and.html

Get email from non default inbox?

Dim WithEvents myitems As Outlook.Items
Dim objDestinationFolder As Outlook.MAPIFolder

Sub Application_Startup()

Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.MAPIFolder
Dim myitems As Outlook.Items
Dim strFilter As String

' let the user choose which account to use
Set myAccounts = Application.GetNamespace("MAPI").Stores
For i = 1 To myAccounts.Count
    res = MsgBox(myAccounts.Item(i).DisplayName & "?", vbYesNo)
    If res = vbYes Then
        Set myInbox = myAccounts.Item(i).GetDefaultFolder(olFolderInbox)
        Exit For
    End If
Next
If myInbox Is Nothing Then Exit Sub ' avoid error if no account is chosen
Set objDestinationFolder = myInbox.Parent.Folders("Inbox")

For Count = myInbox.Items.Count To 1 Step -1
    Call myitems_ItemAdd(myInbox.Items.Item(Count))
Next Count
StopRule

End Sub

' Run this code to stop your rule.
Sub StopRule()
Set myitems = Nothing
End Sub

' This code is the actual rule.
Private Sub myitems_ItemAdd(ByVal Item As Object)

Dim objProjectFolder As Outlook.MAPIFolder
Dim folderName As String

' Search for email subjects that contain a case number
' Subject line must have the sequence of 4 numbers + - + 3 numbers (CPS case number syntax)
   Set objRegEx = CreateObject("VBScript.RegExp")
   objRegEx.Global = False
   objRegEx.Pattern = "[0-9]{4,4}\-?[0-9]{0,3}"
   Set colMatches = objRegEx.Execute(Item.Subject)

'For all matches, move those matches to respective folder (create folder if it does not exist)
If colMatches.Count > 0 Then
    For Each myMatch In colMatches
        folderName = "Docket # " & myMatch.Value
        If FolderExists(objDestinationFolder, folderName) Then
            Set objProjectFolder = objDestinationFolder.Folders(folderName)
        Else
            Set objProjectFolder = objDestinationFolder.Folders.Add(folderName)
        End If
        Item.Move objProjectFolder
    Next
End If

Set objProjectFolder = Nothing

End Sub

Function FolderExists(parentFolder As MAPIFolder, folderName As String)

Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Global = False
objRegEx.Pattern = folderName

For Each F In parentFolder.Folders
    Set colMatches = objRegEx.Execute(F.Name)
    If colMatches.Count > 0 Then
        FolderExists = True
        folderName = colMatches(0).Value
        Exit Function
    End If
Next

FolderExists = False
End Function

Tony Dallimore Tony Dallimore · Accepted Answer · 2016-10-14T09:27:57

I recently upgraded to Outlook 2016 and had the same problem: the default Inbox was not where I expected it.

When I installed Outlook 2016, it created a default store “outlook data file”. As I added my email accounts, it created a separate store for each of them. It was not until later I realised the default Inbox was in the unused “outlook data file”.

For your interest, this macro will display the name of the store holding the default Inbox:

Sub DsplUsernameOfStoreForDefaultInbox()

  Dim NS As Outlook.NameSpace
  Dim DefaultInboxFldr As MAPIFolder

  Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")
  Set DefaultInboxFldr = NS.GetDefaultFolder(olFolderInbox)

  Debug.Print DefaultInboxFldr.Parent.Name

End Sub

In your code replace

 Set myInbox = myAccounts.Item(i).GetDefaultFolder(olFolderInbox)

by

Set myInbox = Session.Folders("outlook data file").Folders("Inbox")

after replacing "outlook data file" with the name of the store containing the Inbox you wish to access.

You can use this technique for referencing any folder at any depth within any store. For example:

Set FldrTgt = Session.Folders("zzzz").Folders("yyyy").Folders("xxxx").Folders("wwww")

Extra point

I do not see the point of:

Set objDestinationFolder = myInbox.Parent.Folders("Inbox")

This starts at myBox, uses property Parent to go up to the store then property Folders to go down to "Inbox" again. It is the same as:

Set objDestinationFolder = myInbox

Outlook Inbox-to-Folder Sortation Macro for Non-Default Inbox

1 Answers