a script to move oldest email messages from the inbox to another folder

I am looking for a script that search for the oldest email messages (by date) and move what found to another folder, lets call it back up. also a check should occure to find out if the backup folder exist if not create one.
JAWCAsked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

x
 
Chris BottomleyConnect With a Mentor Commented:
The following will go through every folder in teh PST and move the 'old' mails to a folder off the PST root named "ReallyOlduns" ... see the code and replace the folder name as appropriate.

call sub moveold to start the process.

Chris
Sub moveOld()
Dim srcFolder As Object
Dim destfolder As Object
Dim subFolder As Object

   Set srcFolder =
Application.Session.GetDefaultFolder(olFolderSentMail).Parent
   Set destfolder = olNav2Folder(srcFolder.folderPath & "\" &
"ReallyOlduns", True)
   For Each subFolder In srcFolder.Folders
       processSubFolders subFolder, destfolder
   Next
'    strFilter = "[SentOn] >= '" & Format(Date + TimeSerial(0, 0, 0),
"ddddd h:nn AMPM") & "'" & " and " & "[senton] <= '" & Format(Date +
TimeSerial(23, 59, 59), "ddddd h:nn AMPM") & "'"
'    Set olmailitems = myfolder.items.Restrict(strFilter)
'    For Each mai In olmailitems

End Sub

Sub processSubFolders(fldr As Object, destfolder As Object)
Dim subFolder As Object
Dim strFilter As String
Dim olMailItems As Variant
Dim mai As mailitem

   For Each subFolder In fldr.Folders
       processSubFolders subFolder, destfolder
   Next
   strFilter = "[SentOn] <= '" & Format(DateAdd("m", -5, Date) +
TimeSerial(23, 59, 59), "ddddd h:nn AMPM") & "'"
   If fldr.items.Count > 0 Then
       Set olMailItems = fldr.items.Restrict(strFilter)
       For Each mai In olMailItems
           mai.Move destfolder
       Next
   End If

End Sub

Public Function olNav2Folder(foldername As String, Optional
createFolders As Boolean) As Object
Dim olApp As Object
Dim olNs As Object
Dim olfldr As Object
Dim reqdFolder As Object
Dim arrFolders() As String
Dim nestCount As Integer

   On Error Resume Next
   foldername = Replace(Replace(foldername, "/", "\"), "\\", "")
   If Right(foldername, 1) = "\" Then foldername = Left(foldername,
Len(foldername) - 1)
   arrFolders() = Split(foldername, "\")
   Set olApp = CreateObject("Outlook.Application")
   Set olNs = olApp.GetNamespace("MAPI")
   Set reqdFolder = olNs.Folders.item(arrFolders(0))
   For nestCount = 1 To UBound(arrFolders)
       If Not reqdFolder Is Nothing Then
           Set olfldr = reqdFolder.Folders
           Set reqdFolder = olfldr.item(arrFolders(nestCount))
           If reqdFolder <> olfldr.item(arrFolders(nestCount)) Then
               If createFolders Then
                   reqdFolder.Folders.Add (arrFolders(nestCount))
                   Set olfldr = reqdFolder.Folders
                   Set reqdFolder = olfldr.item(arrFolders(nestCount))
               Else
                   Set reqdFolder = Nothing
                   Exit For
               End If
           End If
       Else
       End If
   Next
   Set olNav2Folder = reqdFolder
   Set olApp = Nothing
   Set olNs = Nothing
   Set olfldr = Nothing
   Set reqdFolder = Nothing
End Function

Open in new window

0
 
sjl1986Commented:
I use the software from Pergenex called Auto-Mate.

It lets you choose exactly what criteria to search for and you can specify how long you want the email to sit in your inbox before it moves it out. I set things like newsletters to automatically delete after 2 days, etc. It only works with Outlook unfortunately, so to use it on my Gmail account, I have my Gmail setup as IMAP in Outlook. Hope this helps.

http://www.pergenex.com/index.shtml
0
 
JAWCAuthor Commented:
thank you for the suggestion. unfortunately we are not able to purchase software
0
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
Alexei KuznetsovMicrosoft Outlook MVPCommented:
No need to purchase. This free tool can do that easily, just configure required data range:
http://www.outlookfreeware.com/en/products/all/OutlookFolderMerge/
0
 
JAWCAuthor Commented:
Thankyou thims. it did not work I am afraid
0
 
Chris BottomleyCommented:
a script to take all the 'old' mails and move them.

1. How will date and folders be defined?
2. How is the script to be triggered?

Chris
0
 
Alexei KuznetsovMicrosoft Outlook MVPCommented:
JAWC, what exactly did not work?
0
 
JAWCAuthor Commented:
Hi thims
it did not do what we wanted to do.it does come out with errors.
0
 
Alexei KuznetsovMicrosoft Outlook MVPCommented:
JAWC you can always contact OutlookFreeware.com team on their forum. They will be happy to help you.
0
 
Chris BottomleyCommented:
As are we! ... if you want a script then please advise so it can be set up accordingly and otherwise i'll assume you dont.

Chris
0
 
JAWCAuthor Commented:
Hi Chris, a script to take all the 'old' mails and move them. Yes

1. How will date and folders be defined? anything older then 5 month
2. How is the script to be triggered? a vbscript or by macro.

Thank you for your help
0
 
Chris BottomleyCommented:
The trigger ... a VBS cannot do so as outlook doesn't support that but the question was within outlook VBE are you comfortable with running a macro we provide?

Chris
0
 
Chris BottomleyCommented:
Which folder(s) since that affects the mechanism

Chris
0
 
JAWCAuthor Commented:
I just looked at the security settings macro will not work.
0
 
Chris BottomleyCommented:
ENable the macros then, or are you saying that your IT have disbled you from running scripts ... because if so a script as requested can never work!

Chris
0
 
JAWCAuthor Commented:
Thank you this is excellent. We have a good start.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.