Save all Outlook mailitems to disk with VBA - vba

Question

I have some experience with VBA in Excel, but taking my first steps in Outlook. I need to save all e-mail messages in a designated Outlook folder (Inbox\input) to disk (D:\myArchive\Email\) as .msg files and move mail item to archive folder in Outlook (Inbox\archive).
I have set up a mail rule in Outlook that moves mail to archive folder and runs a script below which actually does what I need. The problem is that I get mail rule error pop-ups occasionally and I struggle to track down the reason. Hence looking to turn away from Outlook mail rule and cycle through all folder contents "on-demand".
How could I convert it to cycle through Outlook folder as well as displace the mail item? Currently running Outlook 2019. Thanks!
edit: sorry, late clarification - target folder is in another mailbox (Office 365 shared mailbox). How to target a different account?
Public Sub saveEmailtoDisk(itm As Outlook.MailItem)
Dim saveFolder, msgName1, msgName2 As String
saveFolder = "D:\myArchive\Email\"
msgName1 = Replace(itm.Subject, ":", "")
msgName2 = Replace(msgName1, "/", "_")
itm.SaveAs saveFolder & msgName2 & ".msg", olMSG
End Sub

Answer 1

The following code assumes that both the input and archive folders are located within the default inbox.
Public Sub saveAndArchiveInputEmails()
Dim saveFolder As String
saveFolder = "D:\myArchive\Email\"
Dim sourceFolder As Folder
Dim destFolder As Folder
With Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set sourceFolder = .Folders("input")
Set destFolder = .Folders("archive")
End With
Dim itm As Object
Dim i As Long
With sourceFolder
For i = .Items.Count To 1 Step -1
Set itm = .Items(i)
If TypeName(itm) = "MailItem" Then
saveEmailtoDisk saveFolder, itm
itm.Move destFolder
End If
Next i
End With
End Sub
Public Sub saveEmailtoDisk(ByRef saveFolder As String, ByVal itm As Object)
Dim msgName1, msgName2 As String
msgName1 = Replace(itm.Subject, ":", "")
msgName2 = Replace(msgName1, "/", "_")
itm.SaveAs saveFolder & msgName2 & ".msg", olMSG
End Sub
EDIT
For a shared mailbox, try the following instead...
With Application.GetNamespace("MAPI")
Dim sharedEmail As Recipient
Set sharedEmail = .CreateRecipient("someone#abc.com")
Dim sourceFolder As Folder
Set sourceFolder = .GetSharedDefaultFolder(sharedEmail, olFolderInbox).Folders("input")
Dim destFolder As Folder
Set destFolder = .GetSharedDefaultFolder(sharedEmail, olFolderInbox).Folders("archive")
End With
For your default inbox...
Dim myInbox As Folder
Set myInbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)