VBA: Scarico allegati da Outlook cartelle in Archivio

[SigmaBeta]

Salve.
Innanzitutto OS=Windows xp Professional; MSOffice 2003.

Ho creato un'applicazione in MSAccess 2003 che scarica gli allegati da Outlook 2003.
L'applicazione scarica ovviamente gli allegati delle lettere presenti nella cartella "Posta in Arrivo" delle "Cartelle Personali".

Mi è stato chiesto di scaricare anche gli allegati nella cartella "Posta in Arrivo" delle "Cartelle in Archivio".

Non riesco a dirigere l'applicazione verso quest'ultima cartella perché tra i vari membri della classe globale della libreria di Outlook non ho trovato nulla che differenzi la "Posta in Arrivo" in cartelle personali o archivio

Allego il codice che regolarmente uso.

Function GetAttachments()
On Error GoTo GetAttachments_err

    Dim strExtension1 As String
    Dim strExtension2 As String
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim w As Outlook.Folders
    Dim Item As Outlook.MailItem
    Dim Atmt As Outlook.Attachment
    Dim FileName As String
    Dim intI As Integer
    Dim Outlook As Object
    Dim strPath As String
    Dim x As String
    
    
    Set Outlook = CreateObject("Outlook.Application")
    strExtension1 = ".rtf"
    strExtension2 = ".doc"
    
    Set ns = Outlook.GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)

    
    MsgBox Inbox.folderPath
    If Inbox.Items.Count = 0 Then
        MsgBox "There are no messages in the Inbox.", vbInformation + vbOKOnly, "TOOL"
        Exit Function
    End If
    
    
   For Each Item In Inbox.Items

        If Item.SentOn > "01.01.2011 00:00:00" And Item.Attachments.Count > 0 Then
        For Each Atmt In Item.Attachments
              If Right(Atmt.FileName, 4) = strExtension1 Or Right(Atmt.FileName, 4) = strExtension2 Then
                FileName = "C:\Temp\" & Atmt.FileName
                Atmt.SaveAsFile FileName
                intI = intI + 1
            End If
        Next Atmt
        End If
    Next
    If intI > 0 Then
        MsgBox "I found " & intI & " attached files.", vbInformation + vbOKOnly, "Finished!"
     Else
        MsgBox "I didn't find any attached files in your mail.", vbInformation + vbOKOnly, "Finished!"
    End If
    
GetAttachments_exit:
       Set Atmt = Nothing
       Set Item = Nothing
       Set ns = Nothing
       Exit Function

GetAttachments_err:
       If Err.Number = 13 Then Resume
       MsgBox "An unexpected error has occurred." _
          & vbCrLf & "Please note and report the following information." _
          & vbCrLf & "Macro Name: GetAttachments" _
          & vbCrLf & "Error Number: " & Err.Number _
          & vbCrLf & "Error Description: " & Err.Description _
          , vbCritical, "Error!"
       Resume GetAttachments_exit

End Function