Solved

Outlook Macro to Move Email to PST Files

Posted on 2013-05-28
15
915 Views
Last Modified: 2013-06-03
I am in the process of moving emails from a mailbox into PST files, however am only limited to do this a few hundred email messages at a time manually, otherwise I receive an error. I found an article where a VB Macro was created to automate this process and prevent the error:

http://blogs.msdn.com/b/robert_mcmurray/archive/2010/02/25/outlook-macros-part-1-moving-emails-into-personal-folders.aspx

I am performing a similar method, however I need the macro to contain a date range smaller than a year.  In my case, I need to be able to put in a range of months within a year into the following PST files such as:

Inbox Date range --- Folder name
1/1/2012 - 3/31/2012 --- 2012 Q1
4/1/2012 - 6/30/2012 --- 2012 Q2
7/1/2012 - 9/30/2012 --- 2012 Q3
10/1/2012 - 12/31/2012 --- 2012 Q4

Sent items Date range --- Folder name
1/1/2012-6/30/2012 --- 2012 Sent Q1Q2
7/1/2012-12/31/2012 --- 2012 Sent Q3Q4


I need it to run through the inbox and sent folders.

I don't have any knowledge of scripting or programming myself, but if you can please enter comments as to where I would modify the date range and folder name, I can take care of the rest.

Thanks so much in advance.
0
Comment
Question by:fireguy1125
  • 9
  • 6
15 Comments
 
LVL 28

Expert Comment

by:omgang
Comment Utility
What is the display name of the PST file/folder you want to move the messages into?
OM Gang
0
 
LVL 28

Expert Comment

by:omgang
Comment Utility
I've modified the routine based upon your request.  It will work to move items from your Inbox.  We'll need to tweak it a bit for Sent Items.  Do you know how to enter this into the VBE in Outlook?
OM Gang




Sub MoveOldEmails()
On Error GoTo Err_MoveOldEmails

    ' 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, strArchiveFolder
   
    ' set the display name for the archive folder you want to move messages to
    strArchiveFolder = "Personal Folders - My Archive"
   
    ' Create an object for the Outlook application.
    Set objOutlook = Application
    ' Retrieve an object for the MAPI namespace.
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    ' Retrieve a folder object for the source folder.
    Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
   
    ' Loop through the items in the folder. NOTE: This has to
    ' be done backwards; if you process forwards you have to
    ' re-run the macro an inverse exponential number of times.
    For intCount = objSourceFolder.Items.Count To 1 Step -1
        ' Retrieve an object from the folder.
        Set objVariant = objSourceFolder.Items.Item(intCount)
        ' Allow the system to process. (Helps you to cancel the
        ' macro, or continue to use Outlook in the background.)
        DoEvents
        ' Filter objects for emails or meeting requests.
        If objVariant.Class = olMail Or objVariant.Class = olMeetingRequest Then
            ' This is optional, but it helps me to see in the
            ' debug window where the macro is currently at.
            Debug.Print objVariant.SentOn




            ' Calculate the difference in years between
            ' this year and the year of the mail object.
            'intDateDiff = DateDiff("yyyy", objVariant.SentOn, Now)
            ' Only process the object if it isn't this year.
            'If intDateDiff > 0 Then

            ' only specify a destination folder if the date range matches
            Select Case objVariant.SentOn
                Case #1/1/2012# To #3/31/2012#
                    strDestFolder = "2012 Q1"
                   
                Case #4/1/2012# To #6/30/2012#
                    strDestFolder = "2012 Q2"
                   
                Case #7/1/2012# To #9/30/2012#
                    strDestFolder = "2012 Q3"
                   
                Case #10/1/2012# To #12/31/2012#
                    strDestFolder = "2012 Q4"
                   
                Case Else
                    strDestFolder = ""
                   
            End Select




                ' Calculate the name of the personal folder.
                'strDestFolder = "Personal Folders (" & _
                    'Year(objVariant.SentOn) & ")"
                   
                   
            ' only move the item if the destination folder variable is a non zero length string
            If strDestFolder <> "" Then
                ' Retrieve a folder object for the destination folder.
                'Set objDestFolder = objNamespace.Folders(strDestFolder).Folders("Inbox")
                Set objDestFolder = objNamespace.Folders(strArchiveFolder).Folders(strDestFolder)
               
                ' Move the object to the destination folder.
                objVariant.Move objDestFolder
                ' Just for curiousity, I like to see the number
                ' of items that were moved when the macro completes.
                lngMovedMailItems = lngMovedMailItems + 1
               
               
                ' Destroy the destination folder object.
                Set objDestFolder = Nothing


            End If
        End If
    Next
   
    ' Display the number of items that were moved.
    MsgBox "Moved " & lngMovedMailItems & " messages(s)."

Exit_MoveOldEmails:
        'destroy object variables
    Set objVariant = Nothing
    Set objSourceFolder = Nothing
    Set objNamespace = Nothing
    Set objOutlook = Nothing
    Exit Sub

Err_MoveOldEmails:
    MsgBox Err.Number & " (" & Err.Description & ") in procedure MoveOldEmails of Module Module3"
    Resume Exit_MoveOldEmails

End Sub
0
 
LVL 28

Expert Comment

by:omgang
Comment Utility
Sorry, declaration should have been specific

Dim strDestFolder As String, strArchiveFolder As String


It will work as I had it before though.
OM Gang
0
 
LVL 28

Expert Comment

by:omgang
Comment Utility
Give this a shot and let me know if you have any problems.  It will prompt to archive either Inbox or Sent Items.  You need to change the value of strArchiveFolder to whatever the display name of your actual archive folder is.
OM Gang


Sub MoveOldEmails()
On Error GoTo Err_MoveOldEmails

    ' 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, intResponse As Integer
    Dim strDestFolder As String, strArchiveFolder As String
   
    ' set the display name for the archive folder you want to move messages to
    'strArchiveFolder = "Personal Folders - My Archive"
    strArchiveFolder = "Archive Folders"
       
           
   
    ' Create an object for the Outlook application.
    Set objOutlook = Application
    ' Retrieve an object for the MAPI namespace.
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    ' Retrieve a folder object for the source folder.
    'Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
   
    ' prompt to archive Inbox or Sent Items
    intResponse = MsgBox("Archive Inbox?", vbYesNoCancel, "Select Folder to Archive")
    Select Case intResponse
        Case vbYes
            Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
           
        Case vbCancel
            GoTo Exit_MoveOldEmails
           
        Case Else
            'includes case when user clicks No at prompt
           
    End Select
   
    If objSourceFolder Is Nothing Then
        intResponse = MsgBox("Archive Sent Items?", vbYesNo, "Select Folder to Archive")
        If intResponse = vbYes Then
            Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderSentMail)
        Else
                'user chose No at second message box
            GoTo Exit_MoveOldEmails
        End If
    End If

   
    ' Loop through the items in the folder. NOTE: This has to
    ' be done backwards; if you process forwards you have to
    ' re-run the macro an inverse exponential number of times.
    For intCount = objSourceFolder.Items.Count To 1 Step -1
        ' Retrieve an object from the folder.
        Set objVariant = objSourceFolder.Items.Item(intCount)
        ' Allow the system to process. (Helps you to cancel the
        ' macro, or continue to use Outlook in the background.)
        DoEvents
        ' Filter objects for emails or meeting requests.
        If objVariant.Class = olMail Or objVariant.Class = olMeetingRequest Then
            ' This is optional, but it helps me to see in the
            ' debug window where the macro is currently at.
            Debug.Print objVariant.SentOn




            ' Calculate the difference in years between
            ' this year and the year of the mail object.
            'intDateDiff = DateDiff("yyyy", objVariant.SentOn, Now)
            ' Only process the object if it isn't this year.
            'If intDateDiff > 0 Then

            ' only specify a destination folder if the date range matches
            Select Case objSourceFolder.Name
                Case "Inbox"
                    Select Case objVariant.SentOn
                        Case #1/1/2012# To #3/31/2012#
                            strDestFolder = "2012 Q1"
                   
                        Case #4/1/2012# To #6/30/2012#
                            strDestFolder = "2012 Q2"
                   
                        Case #7/1/2012# To #9/30/2012#
                            strDestFolder = "2012 Q3"
                   
                        Case #10/1/2012# To #12/31/2012#
                            strDestFolder = "2012 Q4"
                   
                        Case Else
                            strDestFolder = ""
                   
                    End Select
                   
                Case "Sent Items"
                    Select Case objVariant.SentOn
                        Case #1/1/2012# To #6/30/2012#
                            strDestFolder = "2012 Sent Q1Q2"
                           
                        Case #7/1/2012# To #12/31/2012#
                            strDestFolder = "2012 Sent Q3Q4"
                           
                        Case Else
                            strDestFolder = ""
                           
                    End Select
                End Select




                ' Calculate the name of the personal folder.
                'strDestFolder = "Personal Folders (" & _
                    'Year(objVariant.SentOn) & ")"
                   
                   
            ' only move the item if the destination folder variable is a non zero length string
            If strDestFolder <> "" Then
                ' Retrieve a folder object for the destination folder.
                'Set objDestFolder = objNamespace.Folders(strDestFolder).Folders("Inbox")
                Set objDestFolder = objNamespace.Folders(strArchiveFolder).Folders(strDestFolder)
               
                ' Move the object to the destination folder.
                objVariant.Move objDestFolder
                ' Just for curiousity, I like to see the number
                ' of items that were moved when the macro completes.
                lngMovedMailItems = lngMovedMailItems + 1
               
               
                ' Destroy the destination folder object.
                Set objDestFolder = Nothing


            End If
        End If
    Next
   
    ' Display the number of items that were moved.
    MsgBox "Moved " & lngMovedMailItems & " messages(s)."

Exit_MoveOldEmails:
        'destroy object variables
    Set objVariant = Nothing
    Set objSourceFolder = Nothing
    Set objNamespace = Nothing
    Set objOutlook = Nothing
    Exit Sub

Err_MoveOldEmails:
    MsgBox Err.Number & " (" & Err.Description & ") in procedure MoveOldEmails of Module Module3"
    Resume Exit_MoveOldEmails

End Sub
0
 
LVL 1

Author Comment

by:fireguy1125
Comment Utility
Thank you omgang,

I should have been more clear in my original request, however the strDestFolder with the 2012 Q1, Q2, Q3, Q4, are actually supposed to be separate Archive folders, and not subfolders within a single archive folder.

There are a total of 6 Archive Folders. 4 of the Archive folders have an Inbox subfolder. 2 of the Archive folders have Sent Items sub folders.

So the instructions would be to:

1. Move Mail items from Outlook Inbox dated 1/1/2012 - 3/31/2012 to archive folder '2012 Q1' within subfolder 'Inbox'
2. Move Mail items from Outlook Inbox dated 4/1/2012 - 6/30/2012 to archive folder '2012 Q2' subfolder 'Inbox'
3. Move Mail items from Outlook Inbox dated 7/1/2012 - 9/30/2012 to archive folder '2012 Q3' subfolder 'Inbox'
4. Move Mail items from Outlook Inbox dated 10/1/2012 - 12/31/2012 to archive folder '2012 Q4' subfolder 'Inbox'
5. Move Mail items from Outlook Sent Items dated 1/1/2012-6/30/2012 to archive folder '2012 Sent Q1Q2' subfolder 'Sent Items'
6. Move Mail items from Outlook Inbox dated 7/1/2012-12/31/2012 to archive folder '2012 Sent Q3Q4' subfolder 'Sent Items'

I hope this makes this clear, my apologies for not detailing this earlier.

Thank you.
0
 
LVL 1

Author Comment

by:fireguy1125
Comment Utility
Please see the attached image to show you, I would not want mail items directly in the Archive Folders, but rather in the Inbox and Sent items sub folders respectively.

Archive Folders
0
 
LVL 28

Expert Comment

by:omgang
Comment Utility
OK.  I'll make changes.
OM Gang
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 28

Expert Comment

by:omgang
Comment Utility
Pretty minor changes.  I removed a bunch of commented/unused code lines though to clean it up.
OM Gang



Sub MoveOldEmails()
On Error GoTo Err_MoveOldEmails

    ' 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, intResponse As Integer
    Dim strDestFolder As String, strArchiveFolder As String
           
    ' Create an object for the Outlook application.
    Set objOutlook = Application
    ' Retrieve an object for the MAPI namespace.
    Set objNamespace = objOutlook.GetNamespace("MAPI")
   
    ' prompt to archive Inbox or Sent Items
    intResponse = MsgBox("Archive Inbox?", vbYesNoCancel, "Select Folder to Archive")
    Select Case intResponse
        Case vbYes
            Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
           
        Case vbCancel
            GoTo Exit_MoveOldEmails
           
        Case Else
            'includes case when user clicks No at prompt
           
    End Select
   
    If objSourceFolder Is Nothing Then
        intResponse = MsgBox("Archive Sent Items?", vbYesNo, "Select Folder to Archive")
        If intResponse = vbYes Then
            Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderSentMail)
        Else
                'user chose No at second message box
            GoTo Exit_MoveOldEmails
        End If
    End If

   
    ' Loop through the items in the folder. NOTE: This has to
    ' be done backwards; if you process forwards you have to
    ' re-run the macro an inverse exponential number of times.
    For intCount = objSourceFolder.Items.Count To 1 Step -1
        ' Retrieve an object from the folder.
        Set objVariant = objSourceFolder.Items.Item(intCount)
        ' Allow the system to process. (Helps you to cancel the
        ' macro, or continue to use Outlook in the background.)
        DoEvents
        ' Filter objects for emails or meeting requests.
        If objVariant.Class = olMail Or objVariant.Class = olMeetingRequest Then
            ' This is optional, but it helps me to see in the
            ' debug window where the macro is currently at.
            Debug.Print objVariant.SentOn

            ' only specify a destination folder if the date range matches
            Select Case objSourceFolder.Name
                Case "Inbox"
                    Select Case objVariant.SentOn
                        Case #1/1/2012# To #3/31/2012#
                            strArchiveFolder = "2012 Q1"
                            strDestFolder = "Inbox"
                   
                        Case #4/1/2012# To #6/30/2012#
                            strArchiveFolder = "2012 Q2"
                            strDestFolder = "Inbox"
                   
                        Case #7/1/2012# To #9/30/2012#
                            strArchiveFolder = "2012 Q3"
                            strDestFolder = "Inbox"
                   
                        Case #10/1/2012# To #12/31/2012#
                            strArchiveFolder = "2012 Q4"
                            strDestFolder = "Inbox"
                   
                        Case Else
                            strArchiveFolder = ""
                            strDestFolder = ""
                   
                    End Select
                   
                Case "Sent Items"
                    Select Case objVariant.SentOn
                        Case #1/1/2012# To #6/30/2012#
                            strArchiveFolder = "2012 Sent Q1Q2"
                            strDestFolder = "Sent Items"
                           
                        Case #7/1/2012# To #12/31/2012#
                            strArchiveFolder = "2012 Sent Q3Q4"
                            strDestFolder = "Sent Items"
                           
                        Case Else
                            strArchiveFolder = ""
                            strDestFolder = ""
                           
                    End Select
                End Select
                   
            ' only move the item if the destination folder variable is a non zero length string
            If strArchiveFolder <> "" Then
                ' Retrieve a folder object for the destination folder.
                Set objDestFolder = objNamespace.Folders(strArchiveFolder).Folders(strDestFolder)
               
                ' Move the object to the destination folder.
                objVariant.Move objDestFolder
                ' Just for curiousity, I like to see the number
                ' of items that were moved when the macro completes.
                lngMovedMailItems = lngMovedMailItems + 1
               
               
                ' Destroy the destination folder object.
                Set objDestFolder = Nothing


            End If
        End If
    Next
   
    ' Display the number of items that were moved.
    MsgBox "Moved " & lngMovedMailItems & " messages(s)."

Exit_MoveOldEmails:
        'destroy object variables
    Set objVariant = Nothing
    Set objSourceFolder = Nothing
    Set objNamespace = Nothing
    Set objOutlook = Nothing
    Exit Sub

Err_MoveOldEmails:
    MsgBox Err.Number & " (" & Err.Description & ") in procedure MoveOldEmails of Module Module3"
    Resume Exit_MoveOldEmails

End Sub
0
 
LVL 1

Author Comment

by:fireguy1125
Comment Utility
Hi OM Gang,

Thank you for the updated code. Sorry it took so long to get back to you, as I'm only able to work on this after 9PM EST.

When I copied and pasted the code into Visual Basic in Outlook and ran it, it prompted me if I would like to Archive Inbox? - I select Yes.

The next pop-up that immediately appears says:

6 (Overflow) in procedure MoveOldEmails of Module Module3

When i run Debug, and step into, it seems to get stuck at Ln 48:
For intCount = objSourceFolder.Items.Count To 1 Step -1

before jumping to line 135:

MsgBox Err.Number & " (" & Err.Description & ") in procedure MoveOldEmails of Module Module3"
0
 
LVL 28

Expert Comment

by:omgang
Comment Utility
That loop is part of the original code from the link you provided.  It counts backwards from the total item count.  How many messages are in your Inbox?  My first guess is you have over 32,767 items which would exceed the  max value for an integer data-type variable (intCount is declared as an Integer).  A simple test is to change the declaration from Integer to Long.  You won't need to change anything else.

Dim intCount As Long

OM Gang
0
 
LVL 1

Author Comment

by:fireguy1125
Comment Utility
There are over 350,000 messages in the Inbox.

Also, I should mention since this will be a very time consuming process due to the number of messages and size of some of the messages being a few MB, and I really only have 10 hours to allow this to run at any time (9PM to 7AM), will this VB code let me cancel the process manually, and continue where it left off the next time it is run?

Thanks again
0
 
LVL 28

Expert Comment

by:omgang
Comment Utility
350,000!  Oh my gosh.  I give users a bad time when they get over a few thousand in their Inbox.  Anyway....

To stop a macro/routine while processing you can key in Ctrl+Break.  Be advised that this will stop the routine ungracefully and not allow object variables to be destroyed and could result in a lost message (if it was in the process of being moved).

If it were me I'd process in batches either by a fixed number, e.g. 10,000 at a time or for a given date range, e.g. only process messages with a SentOn date between 1/1/2012 & 1/31/2012.  See how long it takes to do one month and then decide if I wanted to do two months the next time.

We can modify the routine easily enough to accept date range parameters or a loop count parameter.

OM Gang
0
 
LVL 1

Author Comment

by:fireguy1125
Comment Utility
Ok, let's modify so it does only 1 range per run Instead of all 6 date ranges. I will then change the dates once it completes. If you can produce one for inbox and a separate one for sent that will probably be best.

Thanks again
0
 
LVL 28

Accepted Solution

by:
omgang earned 500 total points
Comment Utility
I modified to prompt for begin and end dates.  In this way you don't need seperate routines for Inbox and Sent Items folders.  You can select OK (to select Inbox) at the first prompt and then enter 01/01/2012 at the second prompt and 03/31/2012 at the third prompt.  If you cancel, or enter and non-valid date value, at one of the date prompt it will call the error handler (type mis-match) and then exit the routine gracefully.
OM Gang


Sub MoveOldEmails()
On Error GoTo Err_MoveOldEmails

    ' 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, lngCount As Long
    Dim dteStartDate As Date, dteEndDate As Date, dteSentOn As Date
    Dim intResponse As Integer
    Dim strDestFolder As String, strArchiveFolder As String
    Dim varResponse As Variant
           
    ' Create an object for the Outlook application.
    Set objOutlook = Application
    ' Retrieve an object for the MAPI namespace.
    Set objNamespace = objOutlook.GetNamespace("MAPI")
   
    ' prompt to archive Inbox or Sent Items
    intResponse = MsgBox("Archive Inbox?", vbYesNoCancel, "Select Folder to Archive")
    Select Case intResponse
        Case vbYes
            Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
           
        Case vbCancel
            GoTo Exit_MoveOldEmails
           
        Case Else
            'includes case when user clicks No at prompt
           
    End Select
   
    If objSourceFolder Is Nothing Then
        intResponse = MsgBox("Archive Sent Items?", vbYesNo, "Select Folder to Archive")
        If intResponse = vbYes Then
            Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderSentMail)
        Else
                'user chose No at second message box
            GoTo Exit_MoveOldEmails
        End If
    End If
   
        'prompt for date range
    varResponse = InputBox("Enter start date as mm/dd/yyyy", "Begin Date")
    dteStartDate = CDate(varResponse)
   
    varResponse = InputBox("Enter end date as mm/dd/yyyy", "End Date")
    dteEndDate = CDate(varResponse)

   
    ' Loop through the items in the folder. NOTE: This has to
    ' be done backwards; if you process forwards you have to
    ' re-run the macro an inverse exponential number of times.
    For lngCount = objSourceFolder.Items.Count To 1 Step -1
        ' Retrieve an object from the folder.
        Set objVariant = objSourceFolder.Items.Item(lngCount)
        ' Allow the system to process. (Helps you to cancel the
        ' macro, or continue to use Outlook in the background.)
        DoEvents
       
        ' get the sent on date from the item
        dteSentOn = objVariant.SentOn
        ' only process items between the user entered dates
        If dteSentOn >= dteStartDate And dteSentOn <= dteEndDate Then
       
       
            ' Filter objects for emails or meeting requests.
            If objVariant.Class = olMail Or objVariant.Class = olMeetingRequest Then
                ' This is optional, but it helps me to see in the
                ' debug window where the macro is currently at.
                Debug.Print objVariant.SentOn

                ' only specify a destination folder if the date range matches
                Select Case objSourceFolder.Name
                    Case "Inbox"
                        Select Case objVariant.SentOn
                            Case #1/1/2012# To #3/31/2012#
                                strArchiveFolder = "2012 Q1"
                                strDestFolder = "Inbox"
                   
                            Case #4/1/2012# To #6/30/2012#
                                strArchiveFolder = "2012 Q2"
                                strDestFolder = "Inbox"
                   
                            Case #7/1/2012# To #9/30/2012#
                                strArchiveFolder = "2012 Q3"
                                strDestFolder = "Inbox"
                   
                            Case #10/1/2012# To #12/31/2012#
                                strArchiveFolder = "2012 Q4"
                                strDestFolder = "Inbox"
                   
                            Case Else
                                strArchiveFolder = ""
                                strDestFolder = ""
                   
                        End Select
                   
                    Case "Sent Items"
                        Select Case objVariant.SentOn
                            Case #1/1/2012# To #6/30/2012#
                                strArchiveFolder = "2012 Sent Q1Q2"
                                strDestFolder = "Sent Items"
                           
                            Case #7/1/2012# To #12/31/2012#
                                strArchiveFolder = "2012 Sent Q3Q4"
                                strDestFolder = "Sent Items"
                           
                            Case Else
                                strArchiveFolder = ""
                                strDestFolder = ""
                           
                        End Select
                    End Select
                   
                ' only move the item if the destination folder variable is a non zero length string
                If strArchiveFolder <> "" Then
                    ' Retrieve a folder object for the destination folder.
                    Set objDestFolder = objNamespace.Folders(strArchiveFolder).Folders(strDestFolder)
               
                    ' Move the object to the destination folder.
                    objVariant.Move objDestFolder
                    ' Just for curiousity, I like to see the number
                    ' of items that were moved when the macro completes.
                    lngMovedMailItems = lngMovedMailItems + 1
               
               
                    ' Destroy the destination folder object.
                    Set objDestFolder = Nothing


                End If
            End If
        End If
    Next
   
    ' Display the number of items that were moved.
    MsgBox "Moved " & lngMovedMailItems & " messages(s)."

Exit_MoveOldEmails:
        'destroy object variables
    Set objVariant = Nothing
    Set objSourceFolder = Nothing
    Set objNamespace = Nothing
    Set objOutlook = Nothing
    Exit Sub

Err_MoveOldEmails:
    MsgBox Err.Number & " (" & Err.Description & ") in procedure MoveOldEmails of Module Module3"
    Resume Exit_MoveOldEmails

End Sub
0
 
LVL 1

Author Closing Comment

by:fireguy1125
Comment Utility
Thanks so much for all your help!
0

Featured Post

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Following basic email etiquette rules will help you write a professional email and achieve a good, lasting impression with your contacts.
In this fourth video of the Xpdf series, we discuss and demonstrate the PDFinfo utility, which retrieves the contents of a PDF's Info Dictionary, as well as some other information, including the page count. We show how to isolate the page count in a…
In this fifth video of the Xpdf series, we discuss and demonstrate the PDFdetach utility, which is able to list and, more importantly, extract attachments that are embedded in PDF files. It does this via a command line interface, making it suitable …

728 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now