RSSWe had a question from a user who wanted a macro to move mail to a subfolder as it aged. While you could use AutoArchive to do this quickly and easily, no coding required, AutoArchive moves mail to a *.pst file, not a subfolder. If you don't care where the mail is moved to, just that its out of your Inbox, use AutoArchive, set to run every 1 day and configure the Inbox archive setting to the desired number of days.
To use, assign the macro to a command button and run as needed. You could also use this as an application start macro and have it run when Outlook starts.
If you aren't a big fan of moving mail, you can leave it in the Inbox and use custom views to hide older mail.
There are 4 macros on this page plus one code snippet. Two macros show you how to move messages to a folder within your current data file and to move messages to a folder in a new data file. The third macro on this page shows you how to use a Select Case statement to move different Outlook items types, using a different age for each item type. The code sample gives you the code needed to move only messages you've replied to or forwarded.
VBA Macro to Move Aged Email Messages
This code sample checks the default Inbox for email older that 7 days and moves any it finds to a subfolder of the Inbox, called Old.
You'll need to set the age, in days, to your desired number. This sample uses 7 days. You'll also need to replace the data file name.
In this sample, the data file name is an email address because that is what Outlook 2010 uses for data file names. You'll need to change this as well as the folder path you are moving the email to.
Tested in Outlook 2010 and Outlook 2013 with an Exchange mailbox.
The Date field can either be SentOnor ReceivedTime when you are working with email or meeting request and responses.
Sub MoveAgedMail()
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 lngMovedItems 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)
' use a subfolder under Inbox
Set objDestFolder = objSourceFolder.Folders("Old")
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)
' I'm using 7 days, adjust as needed.
If intDateDiff > 7 Then
objVariant.Move objDestFolder
'count the # of items moved
lngMovedItems = lngMovedItems + 1
End If
End If
Next
' Display the number of items that were moved.
MsgBox "Moved " & lngMovedItems & " messages(s)."
Set objDestFolder = Nothing
End Sub
Move messages to a different data file
If you want to move the messages to a new data file, you need to change the destination folder path: Set objDestFolder = objNamespace.Folders("me@domain.com").Folders("Inbox").Folders("Old") to use the GetFolderPath function: Set objDestFolder = GetFolderPath("new-pst-file\folder-name").
That line is the only change needed to use a different data file (well, that line and the function).
Tip: A function can be used by any macro, so I keep the functions together in a separate module. When I add a macro that uses a function, I can easily see if I have that function already.
Sub MoveAgedMail2()
'Get the function from http://slipstick.me/qf
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 lngMovedItems As Long
Dim intCount As Integer
Dim intDateDiff As Integer
Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
'Use a folder in a different data file
Set objDestFolder = GetFolderPath("my-data-file-name\Inbox")
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)
' adjust number of days as needed.
If intDateDiff > 60 Then
objVariant.Move objDestFolder
'count the # of items moved
lngMovedItems = lngMovedItems + 1
End If
End If
Next
' Display the number of items that were moved.
MsgBox "Moved " & lngMovedItems & " messages(s)."
Set objDestFolder = Nothing
End Sub
Move mail you've replied to or forwarded
With a few simple changes, you can convert the macro above to move messages that were replied to or forwarded.
Begin by adding these lines to the top of the macro with the other Dim statements.
Dim lastverb, lastaction As String Dim propertyAccessor As Outlook.propertyAccessor
Using the first macro on this page as the base, replace the code block between the If objVariant.Class... and objVariant.Move lines with the code block below. Because Reply, Reply all, and Forward values are 102, 103, and 104, and to the best of my knowledge, those are the only possible values, we can leave the lastaction value at 7 (was intDateDiff in the original macro).
If objVariant.Class = olMail Then
Set propertyAccessor = objVariant.propertyAccessor
lastverb = "http://schemas.microsoft.com/mapi/proptag/0x10810003"
lastaction = propertyAccessor.GetProperty(lastverb)
' 102, 103, 104 are replied, forwarded, reply all
If lastaction > 7 Then
' use your datafile name and each folder in the path
' the example uses an email address because Outlook 2010
' uses email addresses for datafile names
Set objDestFolder = objNamespace.Folders("diane@domain.com"). _
Folders("Inbox").Folders("completed")
objVariant.Move objDestFolder
Use Case Statements instead of IF statements
This code sample uses Case statement to get the ReceivedTime or CreationTime of email, meeting requests and responses, as well as read receipt reports, then plugs the date value into the calculation. It also allows you to use different dates for each group of items types.
Sub MoveAgedItems()
Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objSourceFolder As Outlook.MAPIFolder
Dim objDestFolder As Outlook.MAPIFolder
Dim obj As Variant
Dim sDate As Date
Dim sAge As Integer
Dim lngMovedItems As Long
Dim intDateDiff As Integer
Dim intCount As Integer
Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
Set objDestFolder = objNamespace.Folders("diane@domain.com"). _
Folders("Inbox").Folders("Old")
For intCount = objSourceFolder.Items.Count To 1 Step -1
Set obj = objSourceFolder.Items.Item(intCount)
DoEvents
Select Case obj.Class
Case olMail
sDate = obj.ReceivedTime
sAge = 180
Case olMeetingResponseNegative, _
olMeetingResponsePositive, _
olMeetingCancellation, olMeetingRequest, _
olMeetingAccepted, olMeetingTentative
sDate = obj.ReceivedTime
sAge = 10
Case olReport
sDate = obj.CreationTime
sAge = 10
Case Else
GoTo NextItem
End Select
intDateDiff = DateDiff("d", sDate, Now)
If intDateDiff > sAge Then
obj.Move objDestFolder
lngMovedItems = lngMovedItems + 1
End If
NextItem:
Next
' Display the number of items that were moved.
MsgBox "Moved " & lngMovedItems & " messages(s)."
Set objDestFolder = Nothing
End Sub
How to use macros
First: You will need macro security set to low during testing.
To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.
After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.
Open the VBA Editor by pressing Alt+F11 on your keyboard.
To put the code in a module:
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
More information as well as screenshots are at How to use the VBA Editor
![Diane Poremsky [Outlook MVP]](https://cdn.statically.io/img/web.archive.org/web/20150209120916im_/http://media.slipstick.com/images/2013/mvp-icon.png){kind=icon}
nThanks for your thoughtful reply, however though i use this machine quite a bit - being retired what else is there to do - i'm a bit intimidated by the idea of doing as you suggest. On top of that, I''d have to go through the whole bqtch of mails to find just which mails to get rid of and as most of isn't ov vitl importance I think htat an entire deleiton could well be in order.
What version of Outlook do you use? Instant Search should make it easy to find anything you need - whether it is in your inbox or another folder. Or, if you just want to hide older mail, use a search folder to display messages that arrived today, or that are unread. You can also use Views to hide older messages if you like to see a "clean" inbox but don't want to move or delete messages. If you are using Outlook 2003 and above with the new pst format, size doesn't matter much - but I would get in the habit of deleting mail you really don't need as you receive or read it, like advertising.
Thanks very much for this, I thought this would be a common request, yet there are so few resources for this online.
How would I modify this so I can run it in Outlook 2007 on my exchange connected email?
Thank you!
It should work fine with Outlook 2007. It works with the default email account, so it should work fine with your exchange account too.
Hi Diane,
Can you let me know if you have a script that we can run on outlook 2010 , which can forwards a mails to a specific ID for those mails that are aged more than 30 minutes in inbox
This macro to run automatically in every 35 minutes. Note this is an exchange account.
Can anyone tell me why this isn't working? This macro is moving all of my Read mail when I only want it to move the messages from a specific sender.
Sub HelpDesk3()
On Error Resume Next
Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objFolderSrc = objNameSpace.GetDefaultFolder(olFolderInbox)
Set objFolderDst = objFolderSrc.Folders("MoveTo")
Set colItems = objFolderSrc.Items
Set colfiltereditems = colItems.Restrict("[UnRead] = False")
For intMessage = colfiltereditems.Count To 1 Step -1
If objVariant.Sender = "me@me.com" Then
colfiltereditems(intMessage).Move objFolderDst
End If
Next
End Sub
try using senderemailaddress here instead of sender:
If objVariant.Sender = "me@me.com" Then
Is there a way (without macros) to copy or move all the emails in my deleted folder to another folder on a daily basis, automatically? Like a scheduled task.
Our admin has a process running every day that deletes all the emails in "deleted" folder. but I am using that folder as a temporary folder and/or archive (after I read and act).
I am happy that each time I hit "delete" the email will move/copy to different folder (other than "deleted").
you would need to use a macro. If the admin is not deleting mail daily you could use autoarchive to copy it to a pst when its a day old. Otherwise, if using Outlook 2010, set up a quick step to move mail instead of hitting the delete button.
Thanks, I am using Outlook 2010 (and Exchange).
I did set up a "quick step" but that requires me to go to the folder select the emails ( I select all of them), and then click the "quick step".
Is there a way to have the "quick step" run automatically? like once a day? and in the background? So I don't have to remember this, go to the folder, etc...
No, QS can't run automatically. You'll need to use a macro, which can be configured to run when something happens, like a reminder on a task that is in a specific category.
Thanks.
Is there a generic macro that I can use?
Use the code at task reminder macro. Remove everything except the 2 if... end if blocks and replace it with the name of the macro you want to run.
MoveAgedMail
I'd remove the If intDateDiff > 7 Then (and its matching end if) so it works on all mail in the folder.
also need to use Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderDeletedItems)
alternately, you could use an item add macro that watches the deleted items folder and moves everything to a new folder as its deleted.
Or... simplify your life and create and use a quick step to move stuff you want to keep and only use the deleted items folder for stuff you don't want. Once you get in the habit, Ctrl+Shift+1 can be second nature. if your mouse or keyboard supports programmable keys you might be able to reprogram a key for the shortcut.
Thanks, I like this idea: use an item add macro that watches the deleted items folder and moves everything to a new folder as its deleted.
Is there an easy Macro you can recommend?
I'm sure I have one around here that just needs a little tweaking, like this one. :)
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim NS As Outlook.NameSpace
Set NS = Application.GetNamespace("MAPI")
Set Items = NS.GetDefaultFolder(olFolderDeletedItems).Items
Set NS = Nothing
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
Set fldMove = Session.GetDefaultFolder(olFolderInbox).Folders("Deleted Stuff")
Item.Move fldMove
End Sub
This macro assumes the folder is you are moving to is under the inbox.
Actually, you'll probably want to use this instead of the other itemadd version so it only looks at mail -
Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
Set fldMove = Session.GetDefaultFolder(olFolderInbox). _
Folders("Deleted Stuff")
Item.Move fldMove
End If
End Sub
And the only way to really delete mail is using Shift + Delete to permanently delete items.
Thanks.
I will try this...
I'm just now starting to try to learn to write and use macros. How difficult would it be for me to add another criteria to this macro in that it would move certain emails with certain subject lines to a designated subfolder after xx days?
It won't be hard at all. stick objVariant.subject="whatever" and in the if line. You could use a separate if... then statement inside the date statement instead.
Thank you for the quick reply. I'm starting to beat my head against the wall, lol. I've been reading and researching this for the last week and when I started I thought that may work and tried it early on but I get a runtime error of '424': object required when I try that. I've been trying to figure it out but I just can't seem to get it to work. FYI, the original macro works great at moving emails to specified folders by date alone, so it's not that.... Any ideas?
That's my fault - i was on my netbook and didn't review the macro - most use item, so i assumed it did too. It uses objVariant instead.
If intDateDiff > 7 AND objVariant.Subject = "whatever" Then
or you can use this format
If intDateDiff > 7 Then
If objVariant.Subject = "whatever" then
'do whatever
end if
end if
Worked like a charm! Thank you for the assistance! This has been a good learning experience.
Hello!
I am interested in an macro that (perhaps using quick step) that sets an reminder on an email, moves it to a specific folder. Then when the reminder is triggered it moves it back to the inbox, marks it unread and flags it.
Is that possible?
I am on Outlook 2013 btw. :)
Regards,
The quick step can set a flag and move the message (its limited to the predefined flags) or you can use a macro to set a reminder, like 3 days from now, and move the message. Add it to the ribbon and its as easy as a quick step.
A second macro is triggered by the reminder - basic idea is here at run macro when reminder fires. You need to identify the item and move it back to the inbox.
Of those two steps, identifying the reminders associated message might be the harder task.Item.Move Session.GetDefaultFolder(olFolderInbox) should handle it.Actually my brain is on vacation. :) The message is identified as the item by the reminder - try this version. I would probably set a category using the quick step, especially if you don't want all mail moved back.
Private Sub Application_Reminder(ByVal Item As Object)
If Item.MessageClass <> "IPM.Note" Then
Exit Sub
End If
If Item.Categories = "Needs Followup" Then
Exit Sub
End If
Item.Move Session.GetDefaultFolder(olFolderInbox)
End Sub
Good morning!
Would you like to help me, please, to use this script to move emails to a default folder to another.
Ex.:
My email is default setting to a file "Outlook.ost" and I have to move the items to a subfolder that is configured in a file "*. Pst".
My Outlook is in Portuguese, the names of the folders in the script must be in Portuguese or in English?
Ex.: “Caixa de Entrada = Inbox.
This is easy?
I will be very grateful if you can help me.
You would use this to call the folder in another data file:
Set objDestFolder = GetFolderPath("New PST\Test Cal")
and use the GetFolderPath function.
I'll add an updated macro to the page with the necessary code changes.
You could send me a copy of cógido to email or post comments in response.
I would like a model of the script so I just alter the paths and file names.
Sorry for the inconvenience.
Thank you!!
The new code sample is at #newpst - you'll need to change the pst path in the macro and get the function.
Hi Diane,
I'm trying to use the second script and I keep running into run-time error 438 (Object doesn't support this property or method) while using Outlook 2010. The error points to the following:
intDateDiff = DateDiff("d", objVariant.SentOn, Now)
I looked over the DateDiff function and other areas and can't determine what's wrong. Any thoughts?
Thank you...
I don't think the problem is with that line. Unless... you are running it against a different folder type. It checks for oMail, so meeting requests should cause a problem. Try adding on error resume next before the For intcount... line. Does it run and if so, how any messages are moved? The ones it skips may give you a clue.
If I wanted to specify to move items older than 7 days and sent from a specific e-mail address how would I do that?
If intDateDiff > 7 AND If objVariant.sender = "alias@domain.com" Then
Should work. If Outlook 2013, objVariant.senderemailaddress should work too.
This works here, in Outlook 2010:
If intDateDiff > 7 And objVariant.SenderEmailAddress = "alias@domain.com" Then
Dear Diane,
Pls advise as I have tried the combination of "If intDateDiff > 7 And objVariant.SenderEmailAddress = "alias@domain.com" Then" and included a sender's email address, but it msgbox prompts that "Moved 0 messages". But, if I leave only this part of the code "If intDateDiff > 7 Then", then the code work just fine. I use MS Office 2010, corporate email and Microsoft exchange. Any ideas as what may be done?
Regards,
Dan
Good morning!
Diane, I'm sorry again for the inconvenience.
I appreciate your help and I hope it doesn’t bother her anymore.
I follow their guidelines to create an example of Macro. Making only minor adjustments.
Unfortunately presented a small error while performing the Macro.
A small window with the following information (below) shows:
"Compile error: 'Sub' or 'Function' not defined".
Below is the part of the macro fails (The text "GetFolderPath" appears selected in yellow):
"
'Create a folder in a different file date
Set objDestFolder = GetFolderPath("Eliane - Emails\Caixa de Entrada")
"
I searched the internet but have not found solutions.
Please, if possible, help me fix this problem.
How I would I directed to another folder PST files?
The target for the new PST file, must have only the name of the folder or the actual file path?
Thank you!
Did you add the GetFolderPath macro to the module? http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/
Hi Diane :)
My Outlook2010 has a number of email accounts and I want to use this to work with a specific Inbox, and not my default. Here are some of the details that I have:
1) 5+ accounts
e: me@you.com - datafile name: 1 meatyou
e: you@mine.com - datafile name: 2 youandmine
e: test@si.com - datafile name: 3 testingsilly
etc
2) My datafiles, pst are not saved in the normal folders, I moved them as per your "move .pst guide". Will that cause an error?
3) I have run this code (http://www.vboffice.net/sample.html?lang=en&mnu=2&smp=65&cmd=showitem) to get the folder details of where I need the emails to go and it shows: \\3 testingsilly\Inbox\ialerts
4) I have installed your "getfolderpath" in to a common module (not on startup) and have set:
Set objDestFolder = GetFolderPath("\\3 testingsilly\Inbox\ialerts")
Basically I've tried both option 1 & 2 and I still result in a '0' result. Yet there are mail items in my inbox over 1 month old.
I'm stuck, I have a lot of non-default variables :) I'd like to adapt this to also move reports I get daily, that aren't in my Inbox.
e: me@you.com - datafile name: 1 meatyou
\\1 meatyou\Inbox\reports\daily
to:
e: test@si.com - datafile name: 3 testingsilly
\\3 testingsilly\Inbox\Reports\FY13-14
Please advise :)
Thank you in advance
2. No, the hard drive location is not a factor.
3. You can right click on the folder, choose properties and get the path - but any way you do it, you don't need the leading \\ in the path.
Thanks Diane,
I still stalled out, however I did make the following change:
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox) to:
Set objSourceFolder = objNamespace.Folders("9 ISS iAlerts").Folders("Inbox") and it works.
Now I need to work out some IF statements so they don't all disappear to the one folder. :) I have found that using the 2nd code with the GetFolder Function it works to move either between existing Inbox/folders and /new account/inbox/folders
So I don't need to run the 2 versions of the code in different modules.
Hi again, I've run this now a few times however it leaves behind read receipts.
Is this because they are different objects?
How can I include them in the move?
Thank You :)
Yes, it is because they aren't mailitems, they are reportitems. You have two choices: remove the If statement (and matching End if) and move everything or check for olReport too.
If objVariant.Class = olMail or objVariant.Class = olReport Then
Thank you :)
I now have a new error:
"Run-time error '438':
Object doesn't support this property or method"
error line: intDateDiff = DateDiff("d", objVariant.SentOn, Now)
Full code:
Dim objVariant As Variant
If objVariant.Class = olMail Or objVariant.Class = olReport Then
'Perform logic to determine difference between NOW and the date of the item.
intDateDiff = DateDiff("d", objVariant.SentOn, Now)
'If Date is older than 0 days (or today) then apply the following logic, change as needed
If intDateDiff > 21 Then
All the mail moves correctly, it is just the "Return Receipt (Displayed)" that don't move.
The Return receipts don't have report the dates the same way - you'll need to use CreationTime - this will check the type and choose the field -
Dim sDate As Date
If objVariant.Class = olMail Then
sDate = objVariant.SentOn
ElseIf objVariant.Class = olReport Then
sDate = objVariant.CreationTime
Else
GoTo NextItem
End If
intDateDiff = DateDiff("d", sDate, Now)
BTW, you don't want to exit the sub in the Else line, you want to use Goto to skip down to the Next to keep the macro running.
Else
GoTo NextItem
End If
NextItem:
Next
As an FYI, I added another macro to the page that uses Select Case to move items - you can also set different values for the age, based on item type. It's at the end of the article.
Hi Diane, Great work & thanks for your tremendous support :)
I've been using the CASE statement to move as per your instructions, is there a way to adapt that to also move based on email address?
I've tried using the same structure but it just doesn't work. I'm sure it's because I can't get the object right with the first CASE select.
Ideally I'd want to have "object" as well as a 2nd CASE for email address.
CASE obj.senderemailaddress
if email = contractor @ mail then
sAge = 120
if email = newsletter @ mail then
sAge 3
End Case
This way I can always leave ongoing emails in the inbox, project negotiations etc until the project is complete, then move them and then remove the CASE line for them.
Is this possible?
Cheers,
Karen
(MrsAdmin on the Forum)
The thread is here - http://forums.slipstick.com/threads/91517-modifying-macro-moveagedmail-2-use-categories-to-as-variable/
Case statements are set up like
Select Case obj.senderemailaddress
Case contractors@domain.com
sAge = 120
Case nbewsletters@domain.com
sAge = 3
Case else
sAge = 50
End case
Diane:
I have been using this for several months & today ran into an issue. I traced it to the statement
intDateDiff = DateDiff("d", objVariant.SentOn, Now)
This was reporting that the object did not support the property. The message in question was a microsoft Outlook-generated "Undeliverable" message. I got around this by adding the following line just before the offending statement:
If Left(objVariant, 14) = "Undeliverable:" Then GoTo SkipIt
where SkipIt is a lable ahead of the Next statement.
I'm curious as to why this suddenly became a problem; I've had other Undeliverable messages in the past & I don't recall any such issues. Do you have any ideas?
BTW, I appreciate your tips here. Are you aware of any good resources for learning Outlook VBA? I do quite a bit with Excel, but Outlook has been a bit of a challenge.
I have no idea why it suddenly because an issue. For learning vba, Outlookcode.com has tutorials as does MSDN.
THanks!
Hello Diane,
I am trying to use your script to move messages older tun 30 days from "Sent Items" to "Deleted Items" on Outlook 2010.
Also i will like to run the script on a certain day of the month.
How can i modify the script to achieve my task?
Thank you.
Change the source and destination to:
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderSentMail)
Set objDestFolder = objNamespace.GetDefaultFolder(olFolderdeleteditems)
To run it on a certain day of the month automatically, you need to use a task or appointment reminder. See http://www.slipstick.com/outlook/tasks/open-webpage-task-reminder-fires/ for details. Remove the code that loads IE and just enter the macro name that you want to run.
Hello Diane,
Thank you very much for your support. I changed the code as per your suggestion and it is working 99.9%. It moves all the emails older than 30 days from the "Sent Items" in to "Deleted Items"; however it leaves behind the "Calendar Meetings" and "Tasks".
Is there a way to move those items also?
Appreciate your support.
Sorin
That's because this: If objVariant.Class = olMail Then tells it to look for mail. You can remove that line and the corresponding End If, if you want to move everything.
Hi, I would like to modify macro to be relatively addressed not absolutely. That means, move older messages ti the folder Archive (for example) in the current data file. I have used more data files and I would like move these messages in the current data file to the folder Archive.
Thnx Michael
You'd adjust these lines - use Set objSourceFolder = Application.ActiveExplorer.CurrentFolder if you want to run it on the selected folder and change the destination to the desired destination.
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
Set objDestFolder = objNamespace.Folders("Archive").Folders("Inbox")
Hi Diane
Thanks for this, very insightful. Quick question. I wanted to ato flag(perhaps colour) all emails which have not been replied to within 23 hours of being received. I also wanted to auto flag all emails which had been received, replied to within that timeframe but were still in the inbox(for whatever reason)
Is this possible in outlook 2007?
Cheers
I think you can do it, but will need to use propertyAccessor, specifically, you'd look for the last verb executed then get the time.
Hello Diane,
Your macro was extremely helpful for me, as our company has put a 6 month stipulation on our emails. We can move them to a retention folder, and this macro allows me to do that swiftly. However, I do have a question. My retention folder is not part of my inbox, but my inbox has various subfolders. I can write the macro to pick a specific subfolder to move, but is it possible to write the macro so that it moves everything in my inbox + all my subfolders without having rewrite it with a specific folder each time?
Much thanks! Kit
You can do that, you need a function that goes though each folder. I'll see if i can find the function.
Were you able to find this function? I too would like for it to read multiple folders and move old mail to a subfolder of the read folder
I haven't had time yet, i had to take some time off for a family emergency then went on vacation. Now I need a vacation from vacation. :)
How can you change from the inbox folder to another folder that is not a subfolder of it?
I imagine this line needs changed but not sure what to change it to:
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
Any ideas?
Yes, that is what needs to be changed to use another folder. for one at the same level as the defaults, use parent.folders:
Set objSourceFolder = Session.GetDefaultFolder(olFolderInbox).Parent._
Folders("folder name")
http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/
Hi there, thanks for this post. I have a slightly unique scenario. I need to check company emails on my iphone as well as at work. When checking on my phone its a hassle to browse to each subfolder that I've created under my inbox. Is there a way to modify this script so that it uses existing Outlook rules to move messages from my Inbox after one day to these subfolders. So for example all my mail arrives in my inbox so that I can easily check it on my phone. Then after the message has reached 1 or 2 days old, the script movies it to its specific subfolder depending on rules that I've set up in Outlook already. I have about 20 subfolders that I use. Thanks!
Sure. You can change the date so it moves day old mail. But unless there is a fairly simple way to know which messages get filed where, it might be easier to use Run a script rules to trigger the age macro and set the folders. Or use an addin called Auto-Mate that can do this (and more).
what code would i use if i wanted to have it move ALL mail in ALL sub folders? Private Sub Application_Startup()
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 lngMovedItems As Long
Dim intCount As Integer
Dim intDateDiff As Integer
Dim strDestFolder As String
'''''''''' '''''''''' '''''''''' ''''''''''
'''''''''' Inbox Folder ''''''''''
'''''''''' '''''''''' '''''''''' ''''''''''
Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
' use a subfolder under Inbox
Set objParent = Session.GetDefaultFolder(olFolderInbox)
Set objManaged = objParent.Parent.Folders("Managed Folders")
Set objDestFolder = objManaged.Folders("7 Year Retention")
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)
' I'm using 60 days, adjust as needed.
If intDateDiff > 60 Then
objVariant.Move objDestFolder
'count the # of items moved
lngMovedItems = lngMovedItems + 1
End If
End If
Next
' Display the number of items that were moved.
MsgBox "Moved " & lngMovedItems & " messages(s) From your Inbox ."
Set objDestFolder = Nothing
end sub
I know i need to change this line below:
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
So for the example i have about 30 "sub folders" under my inbox. What would i put in place of Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox) to have it look in ALL the subfolders of Inbox ?
Below is a full copy of the code i'm useing. I have it moving my inbox, sent mail, and i need to have it do subfolders under the main folder? I have several like this
inbox > 30 sub folders
vendors > 10 sub folders
I figure that has to be a better way than to type the code over and over again....
[ FULL CODE ]
Private Sub Application_Startup()
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 lngMovedItems As Long
Dim intCount As Integer
Dim intDateDiff As Integer
Dim strDestFolder As String
'''''''''' '''''''''' '''''''''' ''''''''''
'''''''''' Inbox Folder ''''''''''
'''''''''' '''''''''' '''''''''' ''''''''''
Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
' use a subfolder under Inbox
Set objParent = Session.GetDefaultFolder(olFolderInbox)
Set objManaged = objParent.Parent.Folders("Managed Folders")
Set objDestFolder = objManaged.Folders("7 Year Retention")
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)
' I'm using 60 days, adjust as needed.
If intDateDiff > 60 Then
objVariant.Move objDestFolder
'count the # of items moved
lngMovedItems = lngMovedItems + 1
End If
End If
Next
' Display the number of items that were moved.
MsgBox "Moved " & lngMovedItems & " messages(s) From your Inbox ."
Set objDestFolder = Nothing
'''''''''' '''''''''' '''''''''' ''''''''''
'''''''''' Sent Mail Folder ''''''''''
'''''''''' '''''''''' '''''''''' ''''''''''
Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderSentMail)
' use a subfolder under Inbox
Set objParent = Session.GetDefaultFolder(olFolderInbox)
Set objManaged = objParent.Parent.Folders("Managed Folders")
Set objDestFolder = objManaged.Folders("7 Year Retention")
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)
' I'm using 7 days, adjust as needed.
If intDateDiff > 60 Then
objVariant.Move objDestFolder
'count the # of items moved
lngMovedItems = lngMovedItems + 1
End If
End If
Next
' Display the number of items that were moved.
MsgBox "Moved " & lngMovedItems & " messages(s) From your Sent Mail."
Set objDestFolder = Nothing
End Sub
[ END CODE ]
You need to loop through the folders. I have two samples - http://www.slipstick.com/developer/print-list-of-outlook-folders/ and http://www.slipstick.com/developer/saving-messages-to-the-hard-drive-using-vba/ that show how to loop through subfolders.
I have the code like below for moving aged mails to pst for inbox & sent items
I wanted same thing needs to happen for inbox sub folders around 50 folders
Public lngMovedMailItems, lngMovedMailItems1, lngMovedMailItems2
Sub Application_Startup()
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 intCount As Integer
Dim intDateDiff As Integer
Dim strDestFolder As String
Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNamespace.Folders("xxx@xxx.com").Folders("Inbox")
For intCount = objSourceFolder.Items.Count To 1 Step -1
Set objVariant = objSourceFolder.Items.Item(intCount)
DoEvents
If objVariant.Class = olMail Or objVariant.Class = olMeetingRequest Then
Debug.Print objVariant.SentOn
intDateDiff = DateDiff("d", objVariant.SentOn, Now)
If intDateDiff > 30 Then
strDestFolder = "Old Mails Pst"
Set objDestFolder = objNamespace.Folders(strDestFolder).Folders("Inbox")
objVariant.Move objDestFolder
lngMovedMailItems = lngMovedMailItems + 1
Set objDestFolder = Nothing
End If
End If
Next
Call Application_Startup_Sentitems
End Sub
Sub Application_Startup_Sentitems()
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 intCount As Integer
Dim intDateDiff As Integer
Dim strDestFolder As String
Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNamespace.Folders("xxx@xxx.com").Folders("Sent Items")
For intCount = objSourceFolder.Items.Count To 1 Step -1
Set objVariant = objSourceFolder.Items.Item(intCount)
DoEvents
If objVariant.Class = olMail Or objVariant.Class = olMeetingRequest Then
Debug.Print objVariant.SentOn
intDateDiff = DateDiff("d", objVariant.SentOn, Now)
If intDateDiff > 30 Then
strDestFolder = "Old Mails Pst"
Set objDestFolder = objNamespace.Folders(strDestFolder).Folders("Sent Items")
objVariant.Move objDestFolder
lngMovedMailItems1 = lngMovedMailItems1 + 1
Set objDestFolder = Nothing
End If
End If
Next
lngMovedMailItems2 = lngMovedMailItems1 + lngMovedMailItems
MsgBox "Sent Items Mails Moved " & lngMovedMailItems2 & " messages(s)."
End Sub
for each and every folders we cannot define functions right!!!!!!!!!!!!!!!!!
Any help??????
why are you using a startup macro? you need to get the folder path (using one of the samples i suggested or similar code) as use the path for the source folder.
where do you want the messages moved to?
This is a really rough version of what you need - it doesn't maintain the folder path in the 'old' folder, but should give you an idea of how to do it.
Sub ProcessFolder()
Dim objDestFolder As Outlook.MAPIFolder
Dim objSourceFolder As Outlook.folder
Dim objArchiveFolder As Outlook.folder
Dim olStartFolder As Outlook.MAPIFolder
Dim i As Long
Dim olNewFolder As Outlook.MAPIFolder
Dim olTempFolder As Outlook.MAPIFolder
Dim olTempFolderPath As String
' Loop through the items in the current folder.
Set olStartFolder = Session.PickFolder
If Not (olStartFolder Is Nothing) Then
For i = olStartFolder.Folders.Count To 1 Step -1
Set olTempFolder = olStartFolder.Folders(i)
' do whatever
Set objSourceFolder = olTempFolder
Debug.Print "source " & objSourceFolder.Name
' use a subfolder under Inbox
Set objArchiveFolder = Session.GetDefaultFolder(olFolderInbox).Parent.Folders("Old")
On Error Resume Next
Set objDestFolder = objArchiveFolder.Folders(olTempFolder.Name)
Debug.Print "dest " & objDestFolder
If objDestFolder Is Nothing Then
Set objDestFolder = objArchiveFolder.Folders.Add(olTempFolder.Name)
End If
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)
' I'm using 7 days, adjust as needed.
If intDateDiff > 7 Then
objVariant.Move objDestFolder
'count the # of items moved
lngMovedItems = lngMovedItems + 1
End If
End If
Next
Set objDestFolder = Nothing
Next
' Loop through and search each subfolder of the current folder.
For Each olNewFolder In olStartFolder.Folders
'Don't need to process the Deleted Items folder
If olNewFolder.Name <> "Deleted Items" Or olNewFolder.Name <> "Old" Then
olNewFolder
End If
Next
End If
Set objSourceFolder = Nothing
Set objArchiveFolder = Nothing
End Sub
Hi Diane,
Thanks for the coding, It is very good starting point for Outlook addon. I am not sure if this had been covered? How to move the emails around with POP3 accounts. I have several email accounts, how to deal with that. Will the module will be trigger after I send the reply email or I have to manually trigger it?
The account type doesn't matter - you just need to call the folders - this calls the default inbox and a subfolder under the inbox. You can just as easily use a selected folder as the starting point or use a specific folder in another data file.
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
Set objDestFolder = objSourceFolder.Folders("Old")
instructions for using other folders is here - http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/
Hi Diane,
It is a great starting point for Outlook addons. I am wondering if following two topic covered 1) What if I have more than one accounts? 2) how can I do POP3 account?
many thanks,
POp account won't be a problem - to use it with multiple accounts you need to set the default folder to the other accounts. If you want it to apply to all accounts, you need to reset the default folder to the next account.
This line tells it where to look:
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
you'd need to use getfolderpath function here http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/
with
Set objSourceFolder = GetFolderPath("New PST\Test Cal").Items
Something like this, with two macros - one to set the strings and call the macro that does all of the work.
public sub RunMacro()
Set objSourceFolder = GetFolderPath("New PST\Test Cal").Items
MoveAgedMail
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
MoveAgedMail
End sub
Hi Diane,
Thank for providing this information its been very helpful!
I copied your macro from your first example of how to move old email to a different folder. It seems to work but and messages are moving but I get a debug message that highlights this piece "objVariant.Move objDestFolder". I'm not sure what I did wrong or how to fix this error. I'm using Outlook 2007 and here is the macro:
Sub MoveAgedMail(itm As Outlook.MailItem)
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 lngMovedItems 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)
Set objDestFolder = objSourceFolder.Folders("Aged Emails > 365")
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 > 180 Then
objVariant.Move objDestFolder
lngMovedItems = lngMovedItems + 1
End If
End If
Next
End Sub
Any help to get this corrected would be so greatly appreciated.
What does the error message say? That line moves messages and it either can't find the folder or can't move the message. Do you have report messages, such as read receipts, or meeting requests that it is trying to move?
How to get MoveAgedMail to start in right mailbox
I have two mailboxes in my Oulook 2013
1) Lets call it "david1234@outlook.com" accessed via EAS
2) "DavidArchive" this is a pst file built up over years. Its only purpose it to be a store of old emails. The pst file sits on my hard drive. It does not access the internet and only gets added to if I archive mail from my no 1) mailbox
My problem is that the MoveAgedMail macro insists on working in the Archvive mailbox. It does a great job moving anything over 7 days old from archive/inbox to archive/inbox/old.
In account settings the david1234@outlook.com OST file is shown as default.
I would be so grateful for ideas on how to make the macro work in the No 1) mailbox
Many thanks
David
This line tells it to use the default data file's inbox:
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
You need to get the folder path using GetFolderPath function from this link then use
Set objSourceFolder = GetFolderPath("user@outlook.com\inbox")
http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/
Hi Guru :-)
Please can you help me with a code that can auto forward all email in a folder to a particular email ID if not replied in 7 days and to another email id if remained unreplied for 14 days.
Please any help help is highly appreciable
You need to use propertyaccessors to get the last verb, check to see if it is for reply (102 or 103) or forward (104) and check the received time then forward if the correct last verb doesn't exist.
this works -
dim the objects:
Dim propertyAccessor As Outlook.propertyAccessor
Dim myForward As Outlook.MailItem
use this to forward - I'm only checking for reply, not reply all
If objVariant.Class = olMail Then
Set propertyAccessor = objVariant.propertyAccessor
If propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x10810003") <> 102 Then
intDateDiff = DateDiff("d", objVariant.SentOn, Now)
If intDateDiff > 14 Then
'forward message
Set myForward = objVariant.Forward
myForward.To = "alias1@domain.com"
myForward.Display
ElseIf intDateDiff > 7 Then
Set myForward = objVariant.Forward
myForward.To = "alias2@domain.com"
myForward.Display ' .send
End If
End If
End If
Thanks a lot Diane for your help. I tried and getting a debug error in the following:
If objVariant.Class = olMail Then
Please can you help. I am looking forward to run this rule only on a particular mailbox. Its a kind of generic mailbox.
does the inbox contain meeting request, read receipts etc? objVariant.Class = olMail should weed out non-mail items, but it's possible it's hanging up on something. You could add on error resume next right before the objVariant.Class = olMail line if it's getting hung up on some messages.
I tried it, but now nothing happenes. And i can confirm, there arent any receipts or invites in it. So, I am wondering shall I try it on a particular folder of the mailbox, or on the whole mailbox, what do you suggest.
As configured, it runs on the default inbox in your profile. You said its for a non-default inbox?
See http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/ for the code needed to watch other folders.