Set objDestFolder = objNamespace.Folders("Inbox").Folders(""Folder1").Folders("Folder2")

Sub MoveOldEmails()

    ' Declare all variables.

    Dim objOutlook As Outlook.Application

    Dim objNamespace As Outlook.NameSpace

    Dim objSourceFolder As Outlook.MAPIFolder

    Dim objDestFolder As Outlook.MAPIFolder
    Dim objFolders As Outlook.Folders
    Dim objFolder As Outlook.Folder, objParentFolder As Outlook.Folder

    Dim objVariant As Variant

    Dim lngMovedMailItems As Long

    Dim intCount As Integer, intDays As Integer

    Dim intDateDiff As Integer

    Dim strDestFolder As String, strFolderName As String, strFolder As String, strpath As String


    ' Create an object for the Outlook application.

    Set objOutlook = Application

    ' Retrieve an object for the MAPI namespace.

    Set objNamespace = objOutlook.GetNamespace("MAPI")

    ' Retrieve a folder object for the source folder.

    'Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
    strFolderName = Application.ActiveExplorer.CurrentFolder.Name
    Set objSourceFolder = Application.ActiveExplorer.CurrentFolder
    
'    ' Get full path
    strpath = strFolderName
    Set objParentFolder = objSourceFolder.Parent
    Do Until strFolder = "Personal Folders"
        strpath = objParentFolder.Name & "\" & strpath
        Set objParentFolder = objParentFolder.Parent
        strFolder = objParentFolder.Name
    Loop
    ' Loop through the items in the folder. NOTE: This has to

    ' be done backwards; if you process forwards you have to

    ' re-run the macro an inverse exponential number of times.

    For intCount = objSourceFolder.Items.Count To 1 Step -1

        ' Retrieve an object from the folder.

        Set objVariant = objSourceFolder.Items.Item(intCount)

        ' Allow the system to process. (Helps you to cancel the

        ' macro, or continue to use Outlook in the background.)

        DoEvents

        ' Filter objects for emails or meeting requests.

        If objVariant.Class = olMail Or objVariant.Class = olMeetingRequest Then

            ' This is optional, but it helps me to see in the

            ' debug window where the macro is currently at.

            'Debug.Print objVariant.SentOn & " - " & objVariant.Subject & " - " & DateDiff("d", objVariant.SentOn, Now)

            ' Calculate the difference in years between

            ' this year and the year of the mail object.

            'intDateDiff = DateDiff("yyyy", objVariant.SentOn, Now)
            intDays = DateDiff("d", objVariant.SentOn, Now)
            ' Only process the object if it older than 60 days
            If intDays > 60 Then

                ' Calculate the name of the personal folder.

                strDestFolder = Year(objVariant.SentOn)

                ' Retrieve a folder object for the destination folder.

                'Set objDestFolder = objNamespace.Folders(strDestFolder).Folders("Inbox").Folders(strFolderName)
                Set objDestFolder = objNamespace.(strDestFolder & "\" & strpath)

                ' Move the object to the destination folder.

                objVariant.Move objDestFolder

                ' Just for curiousity, I like to see the number

                ' of items that were moved when the macro completes.

                lngMovedMailItems = lngMovedMailItems + 1

                ' Destroy the destination folder object.

                Set objDestFolder = Nothing

            End If

        End If

    Next


    ' Display the number of items that were moved.

    MsgBox "Moved " & lngMovedMailItems & " messages(s)."


End Sub

Option Explicit

Sub MoveMessage()
Dim olMsg As MailItem
Dim olFolder As Folder
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    GetFolder olMsg, "Folder Name"
lbl_Exit:
    Set olMsg = Nothing
    Exit Sub
End Sub

Sub GetFolder(olItem As MailItem, strFolderName As String)
Dim olNS As NameSpace
Dim cFolders As Collection
Dim olFolder As Outlook.Folder
Dim StartFolder As Outlook.Folder
Dim SubFolder As Outlook.Folder
Dim bExists As Boolean
    Set cFolders = New Collection
    Set olNS = GetNamespace("MAPI")
    Set StartFolder = olNS.PickFolder
    cFolders.Add StartFolder
    Do While cFolders.Count > 0
        Set olFolder = cFolders(1)
        cFolders.Remove 1
        If UCase(olFolder.Name) = UCase(strFolderName) Then
            bExists = True
            Exit Do
        End If
        For Each SubFolder In olFolder.folders
            cFolders.Add SubFolder
        Next SubFolder
    Loop
    If Not bExists Then
        Set olFolder = StartFolder.folders.Add(strFolderName)
    End If
    olItem.Move olFolder
lbl_Exit:
    Set olNS = Nothing
    Set StartFolder = Nothing
    Set cFolders = Nothing
    Set olFolder = Nothing
    Exit Sub
End Sub

Dim objMsg As MailItem
......
Set objMsg = objSourceFolder.Items.Item(intCount)

Dim objMsg As Object

Option Explicit

Sub MoveMessages()
Dim olNS As NameSpace
Dim cFolders As Collection
Dim strFolderName As String
Dim olFolder As Outlook.Folder
Dim StartFolder As Outlook.Folder
Dim SubFolder As Outlook.Folder
Dim olItem As Object
Dim bExists As Boolean
Dim iMsg As Integer

    Set cFolders = New Collection
    Set olNS = GetNamespace("MAPI")
    strFolderName = InputBox("Enter the name of the folder to move the messages to")    'The target folder
    Set StartFolder = olNS.PickFolder
    For iMsg = StartFolder.Items.Count To 1 Step -1
        Set olItem = StartFolder.Items(iMsg)
        If iMsg = StartFolder.Items.Count Then
            cFolders.Add StartFolder
            Do While cFolders.Count > 0
                Set olFolder = cFolders(1)
                cFolders.Remove 1
                If UCase(olFolder.Name) = UCase(strFolderName) Then
                    bExists = True
                    Exit Do
                End If
                For Each SubFolder In olFolder.folders
                    cFolders.Add SubFolder
                Next SubFolder
            Loop
            If Not bExists Then
                Set olFolder = StartFolder.folders.Add(strFolderName)
            End If
        End If
        olItem.Move olFolder
    Next iMsg
lbl_Exit:
    Set olNS = Nothing
    Set StartFolder = Nothing
    Set cFolders = Nothing
    Set olFolder = Nothing
    Set olItem = Nothing
    Exit Sub
End Sub