Все недостающие части выделены в виде комментариев с логикой.

Sub SortMail()
'ждем выделение 1 письма

    On Error GoTo 0 'Resume Next
    Dim FolderName As String - конечная в иерархии папка FolderAdress
    Dim FolderAdress As String - полный путь до папки
    
    'если выделено несколько писем: если начало работы по выделению - ничего не делать. если начало работы по нажатию - выдать ошибку.
    'иначе
        'FolderAdress = Find_the_folder()
        'если FolderAdress не найдено, то FolderNamе = "?"
      'иначе FolderNamе = конечная в иерархии папка FolderAdress.
    'конец если
    'поменять имя кнопки Макроса на панели инструментов на "MoveTo FolderNamе". если FolderName не задано, то ставить "?"

'тут ждем клик на кнопку Макроса
    'если FolderAdress не найдено, то
        'выдать диалог со списком всех папок Inbox включая вложенные для выбора папки. OK и отмена.
        'записать в FolderAdress
    'конец если
    'FolderNamе = конечная в иерархии папка FolderAdress.
    Call MoveIt2Folder(FolderName)
End Sub


==========================================
 Sub MoveIt2Folder(FolderName As String)

'если папка находится на втором уровне вложенности и далее - то надо заходить в нужные подпапки.

On Error GoTo 0 'Resume Next
Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
On Error Resume Next
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objInbox.Folders(FolderName)
On Error GoTo 0 'Resume Next

If objFolder Is Nothing Then
    MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
End If

If Application.ActiveExplorer.Selection.Count = 0 Then
    Exit Sub
End If

For Each objItem In Application.ActiveExplorer.Selection
    If objFolder.DefaultItemType = olMailItem Then
        If objItem.Class = olMail Then
            objItem.Move objFolder
        End If
    End If
Next

' записать лог в файл на диске C: txt в виде Дата+Время письма; Отправитель; Тема перенос в папку Х

Set objItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub

==========================================

Function Find_the_folder()

'On Error Resume Next 'GoTo 0
Dim myOlApp As New Outlook.Application
Dim objNamespace As Outlook.NameSpace
Set objNamespace = myOlApp.GetNamespace("MAPI")
Dim strFilter As String
Dim itm As Object
Dim SubjectOu As String
' ТЕМА = тема выделенного письма
' ПАПКА = папка, где лежит нужное письмо

'найти самое последнее по времени получения письмо во всей папке Inbox с учетом поиска во вложенных папках, где тема like ТЕМА
Set itm = myOlApp.ActiveExplorer()
SubjectOu = "ТЕМА" 'ТЕМА
strFilter = "urn:schemas:httpmail:subject like" & "'" & "%" & SubjectOu & "%" & "'"
SearchSubFolders = True
Scope = "'Inbox'"
Set Search = myOlApp.AdvancedSearch(Scope, strFilter, SearchSubFolders)
Set filteredItems = Search.Results

' тут пытался найти самое последнее по времени получения письмо во всей папке Inbox с учетом поиска во вложенных папках
' не хватает понимания и знания объектов и VBA
For Each itm In filteredItems
Debug.Print itm.Subject
Debug.Print itm.SenderName
Debug.Print itm.SentOn
Next
Set myOlApp = Nothing
 
'определить полный путь папки с где она лежит

'вернуть ПАПКА
End Function