Sub MoveMail()
' Declare all variables.
Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objSourceFolder As Outlook.MAPIFolder
Dim objDestFolder As Outlook.MAPIFolder
Dim objVariant As Variant
Dim lngMovedMailItems As Long
Dim intCount As Integer
Dim intDateDiff As Integer
Dim strDestFolder As String
Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
For intCount = objSourceFolder.Items.Count To 1 Step -1
Set objVariant = objSourceFolder.Items.Item(intCount)
DoEvents
If objVariant.Class = olMail Then
intDateDiff = DateDiff("d", objVariant.SentOn, Now)
If intDateDiff > 7 Then
'use datafile name and each folder in the path - outlook 2010 uses the email address as the pst or mailbox name
Set objDestFolder = objNamespace.Folders("[EMAIL="diane@domain.com").Folders("Inbox").Folders("Old"]diane@domain.com").Folders("Inbox").Folders("Old[/EMAIL]")
objVariant.Move objDestFolder
'count the # of items moved
lngMovedMailItems = lngMovedMailItems + 1
Set objDestFolder = Nothing
End If
End If
Next
' Display the number of items that were moved.
MsgBox "Moved " & lngMovedMailItems & " messages(s)."
End Sub