VBA Outlook：快速找到子文件夹

我的Outlook公用文件夹中具有以下结构。

-Public Folders
--1001_RandomProject
--1002_AnotherProject
--1003_Yetanotherproject
...

依此类推，基本上有数千个（！）子文件夹，每个子文件夹对应一个项目，并以项目编号为前缀。

现在，我正在尝试创建一个宏，该宏将允许用户选择许多邮件项目，通过输入框输入项目编号，然后将这些邮件项目自动移动到与项目编号相对应的子文件夹中。

所有这些工作正常，但是在当前实现中，我遍历“公用文件夹”的所有子文件夹，并将输入的项目编号与文件夹名称的前4个字符进行比较，以查看它们是否匹配，然后移动邮件项目到文件夹。

您可以想象成千上万个子文件夹，这往往很慢。所以我的问题是：是否有另一种方法可以选择正确的文件夹而不遍历所有文件夹（使用诸如“为我找到一个以1001 *开头的文件夹”之类的掩码）。

“查找文件夹”代码的简化部分

Sub verplaatsen()

Dim Boodschap, Titel, Standaard
Dim ProjectNumber As String
Dim NrOfFolders as Integer
Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim FolderName as String


Boodschap = "Enter project number"
Titel = "Move mail"
Standaard = "0000"
ProjectNumber = InputBox(Boodschap, Titel, Standaard)

Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")

NrOfFolders = objNamespace.Folders(3).Folders(12).Folders.Count

I = 2

Do
    FolderName = objNamespace.Folders(3).Folders(12).Folders(I).Name
    If Left(FolderName, 4) = ProjectNumber Then
    Else
        I = I + 1
    End If
Loop Until I = NrOfFolders Or Left(FolderName, 4) = ProjectNumber

MoveMail (I)

End Sub