根据主题行自动将电子邮件保存到本地多个文件夹中

Question

我目前正在尝试制作一个VBA脚本，该脚本将根据主题行将文件保存到其他位置。

我的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).Parent.Folders("Test").Items
Dim fso
Dim xMailItem As Outlook.MailItem
Dim xFilePath As String
Dim xRegEx
Dim xFileName As String






Dim xNameSpace1 As Outlook.NameSpace
Set xNameSpace1 = Outlook.Application.Session
Set InboxItems1 = xNameSpace.GetDefaultFolder(olFolderInbox).Parent.Folders("WIP").Items
Dim fso1
Dim xRegEx1
Dim xMailItem1 As Outlook.MailItem
Dim xFilePath1 As String
Dim xFileName1 As String




End Sub



Private Sub InboxItems_ItemAdd(ByVal objItem As Object)
On Error Resume Next
xFilePath = xFilePath & "C:\New Folder\"
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 & ".html", olHTML
End If
Exit Sub
End Sub



Private Sub InboxItems1_ItemAdd(ByVal objItem1 As Object)
On Error Resume Next
xFilePath1 = xFilePath1 & "C:\Outlook\"
Set fso1 = CreateObject("Scripting.FileSystemObject")
If fso1.FolderExists(xFilePath1) = False Then
fso1.CreateFolder (xFilePath1)
End If
Set xRegEx1 = CreateObject("vbscript.regexp")
xRegEx1.Global = True
xRegEx1.IgnoreCase = False
xRegEx1.Pattern = "\||\/|\<|\>|""|:|\*|\\|\?"
If objItem1.Class = olMail Then
Set xMailItem1 = objItem1
xFileName1 = xRegEx1.Replace(xMailItem1.Subject, "")
xMailItem1.SaveAs xFilePath1 & "\" & xFileName1 & ".html", olHTML
End If
Exit Sub
End Sub