如何转发电子邮件我移动到特定父文件夹的非特定子文件夹？

Question

以下代码转发电子邮件我转移到＆＃39;外包会计＆＃39;的特定子文件夹文件夹中。

我想将电子邮件转发到＆＃39; OutsourcedAccounting＆＃39;的任何子文件夹。无需在添加新子文件夹时更新代码。

我如何才能为OutsourcedAccounting的任何子文件夹工作，而不仅仅是我在代码中明确指定的那些子文件？

Option Explicit
Private WithEvents OutsourcedAccounting As Outlook.Items
Private WithEvents Subfolder1 As Outlook.Items
Private WithEvents subfolder2 As Outlook.Items
Private WithEvents Subfolder3 As Outlook.Items
Private olItem As Outlook.MailItem

Private Sub Application_Startup()
Dim olApp As Outlook.Application
    Set olApp = Outlook.Application
    Set OutsourcedAccounting = GetNS(olApp).GetDefaultFolder(olFolderInbox).Folders("Outsourced Accounting").Items
    Set Subfolder1 = GetNS(olApp).GetDefaultFolder(olFolderInbox).Folders("Outsourced Accounting").Folders("Subfolder1").Items
    Set subfolder2 = GetNS(olApp).GetDefaultFolder(olFolderInbox).Folders("Outsourced Accounting").Folders("subfolder2").Items
    Set Subfolder3 = GetNS(olApp).GetDefaultFolder(olFolderInbox).Folders("Outsourced Accounting").Folders("Subfolder3").Items
lbl_Exit:
    Exit Sub
End Sub

Private Sub OutsourcedAccounting_ItemAdd(ByVal item As Object)
    On Error GoTo err_Handler
    Set olItem = item.Forward
    olItem.Recipients.Add "forwardingemail@gmail.com"
    olItem.Save
    olItem.Send
lbl_Exit:
    Exit Sub
err_Handler:
    MsgBox Err.Number & " - " & Err.Description
    GoTo lbl_Exit
End Sub

Private Sub Subfolder1_ItemAdd(ByVal item As Object)
    On Error GoTo err_Handler
    Set olItem = item.Forward
    olItem.Recipients.Add "forwardingemail@gmail.com"
    olItem.Save
    olItem.Send
lbl_Exit:
    Exit Sub
err_Handler:
    MsgBox Err.Number & " - " & Err.Description
    GoTo lbl_Exit
End Sub

Private Sub subfolder2_ItemAdd(ByVal item As Object)
    On Error GoTo err_Handler
    Set olItem = item.Forward
    olItem.Recipients.Add "forwardingemail@gmail.com"
    olItem.Save
    olItem.Send
lbl_Exit:
    Exit Sub
err_Handler:
    MsgBox Err.Number & " - " & Err.Description
    GoTo lbl_Exit
End Sub

Private Sub Subfolder3_ItemAdd(ByVal item As Object)
    On Error GoTo err_Handler
    Set olItem = item.Forward
    olItem.Recipients.Add "forwardingemail@gmail.com"
    olItem.Save
    olItem.Send
lbl_Exit:
    Exit Sub
err_Handler:
    MsgBox Err.Number & " - " & Err.Description
    GoTo lbl_Exit
End Sub

Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace
    Set GetNS = app.GetNamespace("MAPI")
lbl_Exit:
    Exit Function
End Function