Solved

Outlook Macro to Move Email to PST Files

Posted on 2013-05-28
15
995 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
ID: 39202680
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
ID: 39202782
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
ID: 39202787
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
Efficient way to get backups off site to Azure

This user guide provides instructions on how to deploy and configure both a StoneFly Scale Out NAS Enterprise Cloud Drive virtual machine and Veeam Cloud Connect in the Microsoft Azure Cloud.

 
LVL 28

Expert Comment

by:omgang
ID: 39202875
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
ID: 39203293
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
ID: 39203298
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
ID: 39204578
OK.  I'll make changes.
OM Gang
0
 
LVL 28

Expert Comment

by:omgang
ID: 39204655
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
ID: 39206516
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
ID: 39207720
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
ID: 39207874
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
ID: 39207908
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
ID: 39208312
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
ID: 39208390
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
ID: 39216366
Thanks so much for all your help!
0

Featured Post

Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Find out what you should include to make the best professional email signature for your organization.
An introduction to basic programming syntax in Java by creating a simple program. Viewers can follow the tutorial as they create their first class in Java. Definitions and explanations about each element are given to help prepare viewers for future …
With the power of JIRA, there's an unlimited number of ways you can customize it, use it and benefit from it. With that in mind, there's bound to be things that I wasn't able to cover in this course. With this summary we'll look at some places to go…

809 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