Sub MoveAllMessages()
Dim olkSource As Outlook.MAPIFolder, _
olkDestination As Outlook.MAPIFolder, _
olkMsg As Outlook.MailItem, _
intIndex As Integer
'Change the folder path on the following line
Set olkSource = OpenOutlookFolder("Testing\Folder1")
'Change the folder path on the following line
Set olkDestination = OpenOutlookFolder("Testing\Folder2")
For intIndex = olkSource.items.Count To 1 Step -1
olkSource.items.Item(intIndex).Move olkDestination
Next
Set olkSource = Nothing
Set olkDestination = Nothing
Set olkMsg = Nothing
MsgBox "Finished!", vbInformation + vbOKOnly, "Move All Messages"
End Sub
Function IsNothing(obj)
If TypeName(obj) = "Nothing" Then
IsNothing = True
Else
IsNothing = False
End If
End Function
Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
Dim arrFolders As Variant, _
varFolder As Variant, _
olkFolder As Outlook.MAPIFolder
On Error GoTo ehOpenOutlookFolder
If strFolderPath = "" Then
Set OpenOutlookFolder = Nothing
Else
If Left(strFolderPath, 1) = "\" Then
strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
End If
arrFolders = Split(strFolderPath, "\")
For Each varFolder In arrFolders
If IsNothing(olkFolder) Then
Set olkFolder = Session.Folders(varFolder)
Else
Set olkFolder = olkFolder.Folders(varFolder)
End If
Next
Set OpenOutlookFolder = olkFolder
End If
On Error GoTo 0
Exit Function
ehOpenOutlookFolder:
Set OpenOutlookFolder = Nothing
On Error GoTo 0
End Function