Outlook Inbox-to-Folder Sorting Macro для не входящих по умолчанию входящих сообщений

Question

Я пытаюсь в VBA для Outlook 2013 сортировать любую почту с определенным номером в теме в соответствующие папки. Если папка не существует (если строки в теме и папке не совпадают), папка создается. Мне нужен этот макрос для обработки не входящих по умолчанию входящих сообщений. Следующие ссылки - это то, где я получил исходный код, который соединен вместе внизу. Я получаю сообщение об ошибке во время выполнения программы (-2147221233 (8004010f)) на линии:

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 

Answer 1

Я недавно обновлен до Перспективы 2016 года и была такая же проблема: вложенная папка по умолчанию была не там, где я этого ожидал.

Когда я установил Outlook 2016, он создал хранилище данных «Outlook Outlook» по умолчанию. Когда я добавил свои учетные записи электронной почты, он создал отдельный магазин для каждого из них. Только после этого я понял, что по умолчанию Inbox был в неиспользуемом файле данных Outlook.

Для вашего интереса, этот макрос будет отображаться название магазина холдинг Входящие по умолчанию:

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 

В коде заменить

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

по

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

после замены «файл данных Outlook» с именем магазина, содержащего папку «Входящие», к которой вы хотите получить доступ.

Вы можете использовать эту технику для ссылки на любую папку на любой глубине в любом магазине. Например:

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

Дополнительные точки

Я не вижу смысла:

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

Это начинается myBox, использует свойство Parent, чтобы идти в магазин то папки собственности снова перейти к «Входящие». Это то же самое, что и:

Set objDestinationFolder = myInbox