After a quick search on the net, it was suggested that this could work. I've not tried it so no guarantees:
Sub MoveDraftMail()
 Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objSourceFolder As Outlook.MAPIFolder
Dim objDestFolder As Outlook.MAPIFolder
Dim objItem As Variant
Dim Archive_Folder As Outlook.MAPIFolder
Set objOutlook = New Outlook.Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNamespace.Folders(10).Folders("Name of Folder")
Set Archive_Folder = objNamespace.Folders("Online Archive - My@email").Folders("Personal_Folders").Folders("2021").Folders("InBox")
For Each objItem In objSourceFolder.Items
    If TypeName(objItem) = "MailItem" Then
    objItem.Move Archive_Folder
    End If
Next objItem
Set objDestFolder = Nothing
End Sub