将文件夹添加到ItemAdd代码的单个实例

Question

我有ItemAdd代码，我想将其应用于Outlook收件箱中的每个文件夹。

例如，如果我有规则将电子邮件移动到Outlook＆＃34;其他＆＃34;文件夹，我希望它保存到Windows＆＃34; \ MyEmails＆＃34;夹。

我不想单独添加每个文件夹。 VBA代码可以添加所有文件夹吗？

Private WithEvents InboxItems As Outlook.Items

Sub Application_Startup()
Dim xNameSpace As Outlook.NameSpace
Set xNameSpace = Outlook.Application.Session
Set InboxItems = xNameSpace.GetDefaultFolder(olFolderInbox).Items
End Sub


Private Sub InboxItems_ItemAdd(ByVal objItem As Object)  

Dim FSO
Dim xMailItem As Outlook.MailItem
Dim xFilePath As String
Dim xRegEx
Dim xFileName As String

On Error Resume Next

xFilePath = CreateObject("WScript.Shell").SpecialFolders(16)
xFilePath = xFilePath & "\MyEmails"

Set FSO = CreateObject("Scripting.FileSystemObject")

If FSO.FolderExists(xFilePath) = False Then
    FSO.CreateFolder (xFilePath)
End If

Set xRegEx = CreateObject("vbscript.regexp")

xRegEx.Global = True
xRegEx.IgnoreCase = False
xRegEx.Pattern = "\||\/|\<|\>|""|:|\*|\\|\?"

If objItem.Class = olMail Then
    Set xMailItem = objItem
    xFileName = xRegEx.Replace(xMailItem.Subject, "")
    xMailItem.SaveAs xFilePath & "\" & xFileName & ".msg", olMsg
End If

Exit Sub

End Sub