MsOf13 VBA Support on Outlook

Hi Everyone,
I'm trying to modify the VBA that i found in InterNET, I need to save the attachments to specific folder by Automatically.
But This Script will check only the Inbox, I need to check both Inbox and and Sub folders and save the attachments to Specific folder.

Can anyone help me on this.

Code:

'Option Explicit

Public WithEvents Items As Outlook.Items



Public Sub Application_Startup()

  Dim olApp As Outlook.Application

  Dim objNS As Outlook.NameSpace

  

  Set olApp = Outlook.Application

  Set objNS = olApp.GetNamespace("MAPI")

  

    Dim Inbox  As Outlook.MAPIFolder

    Set Inbox = objNS.GetDefaultFolder(olFolderInbox)

    

   Dim Sub_folder  As Outlook.MAPIFolder

    Set Sub_folder = Inbox.Folders("Test")



    Set Items = Sub_folder .Items



End Sub

Public Sub Items_ItemAdd(ByVal Item As Object)



On Error GoTo ErrorHandler



  Dim Msg As Outlook.MailItem

  Dim objAtt As Outlook.Attachment

  



  FolderPath = "C:\Users\xxxxxxxx\Desktop\Test" & "\"

  



    If InStr(1, Msg.SenderEmailAddress, "@test2.com") > 0 Then

        For Each objAtt In Msg.Attachments

            objAtt.SaveAsFile FolderPath & "Input\" & objAtt.DisplayName

        Next

    End If



   If InStr(1, Msg.SenderEmailAddress, "@test3.com") > 0 Then

       For Each objAtt In Msg.Attachments

           objAtt.SaveAsFile FolderPath & "Input\" & objAtt.DisplayName

    Next

End If



End If

  

ProgramExit:

  Exit Sub

  

ErrorHandler:

  MsgBox Err.Number & " - " & Err.Description

  Resume ProgramExit

End Sub

Thanks in Advance.