Sub test()
Dim objSession As Outlook.NameSpace
Dim objFolder1 As Outlook.MAPIFolder
Dim objFolder2 As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem
Set objSession = Application.Session
Set objFolder1 = objSession.DefaultStore.GetRootFolder().Folders("***")
Set objFolder2 = objFolder1.Folders("***")
For Each objItem In objFolder1.Items
objItem.Move objFolder2
Next
Set objItem = Nothing
Set objFolder1 = Nothing
Set objFolder2 = Nothing
Set objSession = Nothing
End Sub
可能一次移不干净,多运行几次就是了。