We 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. "Macro to file Outlook email by sender's display name" has versions that file into folders by name, domain, or date.
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 fromhttp://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 = objSourceFolder.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
Feni Lusilia says
Hi Diane,
I have found a VBA that will help me move messages that are selected first from certain customers (defined by their email address) to hard drive folder. But I still don't know how to move it based on the date range.
It would be better if the user can enter the date range (because I don't want the user to change the code itself) and macro will go through all folders in my inbox and copy those within the date range and have the email address that I specified to the hard drive.
(this email address help me rename them when I copy it to hard drive).
Do you have VBA code that can help me?
Thank you in advance for your help.
Diane Poremsky says
You'll need to use filter / restrict and move the messages that are found. To get the dates, you can either use a userform or input box. I don't think I have a macro published here that does it - especially for email and will check my files.
Feni Lusilia says
Thank you for your suggestion. Actually I just found a macro that will select those within the date range (just in the active folder). But when I tried it, it didn't work. I still don't know why.
Diane Poremsky says
Can you post the macro or a link to it (if you found it online)? I'll take a look at it.
Kayla Wewer says
Hi, I am trying to sort emails by year received into sub folders for my archives, is there a way to code that using macros. Thank you in advance for any help.
Diane Poremsky says
Yes, it is possible. I'm pretty sure I have macro around here that does it, will look for it.
Are the "archives" pst files you archives mail to or just folders in your mailbox?
nick says
Hello, Is there a way to move 30 days of email each time the script is run. So If I have 120 days of email items and I run the script it will move 30 days. Then if i run the script right after it will move another 30 days.
Diane Poremsky says
Yeah, you could loop. I assume you want to move the oldest messages first?
Diane Poremsky says
Actually, looping wouldn't work - unless it popped up a 'do you want to continue dialog"
You can use an input box to ask for the value
' with the other dim statements
dim lAge as long
' needs to be before the For loop - after the Set lines is fine, or right after Dim's.
lAge = inputbox ("Minimum age of old mail to move?")
If intDateDiff > lAge Then
nick says
Thanks for your suggestion...I modifed one of the scripts to help me move the emails for the last 2 days. This is the script that I need help to move the 30 days.
Public Sub PSTMove()
Dim objFolders As Outlook.Folders
Dim objFolder As Outlook.Folder
'Get all the folders in a specific PST file
Set objFolders = Outlook.Application.Session.Folders("Test Archive").Folders
For Each objFolder In objFolders
Call MoveEmails(objFolder)
Next
End Sub
Private Sub MoveEmails(ByVal objFolder As Outlook.Folder)
Dim objTargetFolder As Outlook.Folder
Dim objSubFolder As Outlook.Folder
Dim i As Long
Dim objMail As Outlook.MailItem
Dim objVariant As Variant
Dim lngMovedItems As Long
Dim intCount As Integer
Dim intDateDiff As Integer
'Get the specific destination folder
'You can change it as per your case
Set objTargetFolder = Outlook.Application.Session.Folders("Test Online").Folders("Inbox")
If objTargetFolder Is Nothing Then
Set objTargetFolder = Outlook.Application.Session.Folders("Test Online").Folders.Add("Inbox")
End If
'Move each emails in the folder to the destination folder
For intCount = objFolder.Items.Count To 1 Step -1
Set objVariant = objFolder.Items.Item(intCount)
DoEvents
If objVariant.Class = olMail Then
intDateDiff = DateDiff("d", objVariant.SentOn, Now)
' adjust number of days as needed.
If intDateDiff < 2 Then
objVariant.Move objTargetFolder
'count the # of items moved
lngMovedItems = lngMovedItems + 1
End If
End If
Next
'Process the subfolders in the folder recursively
If (objFolder.Folders.Count > 0) Then
For Each objSubFolder In objFolder.Folders
Call MoveEmails(objSubFolder)
Next
End If
End Sub
Diane Poremsky says
Either using 30 in that field or my method to enter a value should work.
nick says
I think your method would be better because when i put 30 it runs for 30 days of items but i need to find a way to run it again and then have it move another 30 items.
nick says
When I applied the script lines you sent, I m prompted to enter a number and then items move to the pst. I entered 2 and two days of items moved. When I run it again I have to enter another number e.g. 1 to move another day of items. Can i do it in such a way not to enter any numbers and just a set amount is moved?
Diane Poremsky says
Do you want to do it by number of messages moved or all messages in a period?
You need to use a loop to have it move 2 days at a time - then need to ask to continue or quit.
Erik says
This is a good idea, how would I do that? Move 100 messages then click continue or quit. Thank you!
nick says
Hello,
this is where i got to regarding moving a specific amount of email from Archive pst to Online archive. If i move items from the main mailbox folders the script works fine. But I cannot seem to access a pst file and then move the emails. I am stuck at Set inboxItems = inboxFolder.Items.....Error, object doesn't support this property or method. Runtime error 438. Can you say is this is even possible?
Public Sub PSTMove()
Dim outApp As Object
Dim outNS As Object
Dim inboxFolder As Object
Dim destFolder As Object
Dim outEmail As Object
Dim inboxItems As Object
Dim i As Integer
Dim inputNumber As String
Dim numberToMove As Integer
Dim objTargetFolder As Outlook.Folder
Dim objFolders As Outlook.Folders
Dim objFolder As Outlook.Folder
inputNumber = InputBox("Enter number of emails to move")
On Error Resume Next
numberToMove = CInt(inputNumber)
On Error GoTo 0
If numberToMove < 1 Then Exit Sub
'Get the specific destination folder
Set objTargetFolder = Outlook.Application.Session.Folders("Test Online").Folders("Inbox")
If objTargetFolder Is Nothing Then
Set objTargetFolder = Outlook.Application.Session.Folders("Test Online").Folders.Add("Inbox")
End If
Set outApp = CreateObject("Outlook.Application")
Set outNS = outApp.GetNamespace("MAPI")
'Set inboxFolder = outNS.GetDefaultFolder(olFolderInbox)
'Set Items = GetFolderPath("Test Archive\Inbox").Items
Set inboxFolder = Outlook.Application.Session.Folders("Test Archive").Folders
'Sort Inbox items by Received Time
Set inboxItems = inboxFolder.Items
inbox.sort "[ReceivedTime]", True
'Loop through sorted items for the number entered by the user, up to the number of items in the Inbox
For i = inboxFolder.Items.Count To inboxFolder.Items.Count - numberToMove + 1 Step -1
Set outEmail = inboxItems(i)
'Debug.Print i, outEmail.Subject
outEmail.Move objTargetFolder
Next i
End Sub
Diane Poremsky says
Your code is missing the inbox - but if you want it to work on any folder, don't set a specific folder name
Set inboxFolder = Outlook.Application.Session.Folders("Test Archive").Folders("Inbox")
use current folder -
Set inboxFolder = Application.ActiveExplorer.CurrentFolder
nick says
I used Set inboxFolder = Application.ActiveExplorer.CurrentFolder
This is working. Thanks very much......
Is there a way to specify the entire pst and all its folders without using "current folder"
Luke says
Hi Diane,
I receive a lot of intra reports daily and they all have the same subject line, is there way to create a macro that only keeps the latest one in the inbox and moves the rest into a subfolder?
Thanks
Luke
Diane Poremsky says
I have a macro for that -
https://www.slipstick.com/developer/delete-older-messages-new-message-arrives/
It deletes but can just as easily move.
Luke says
Hi Diane,
Excuse my ignorance however I never worked with macros at all and this will be my first time, can I kindly ask for some more help here.
Thanks
Luke
Diane Poremsky says
You'll use one of the macros on the other page and replace the delete with move. You also need to set the move to folder.
https://www.slipstick.com/developer/delete-older-messages-new-message-arrives/
This will move to a subfolder of the inbox.
Replace the bjowatchfolder line with this:
Dim objDestFolder As Outlook.MAPIFolder
Set objWatchFolder = objNS.GetDefaultFolder(olFolderInbox)
Set objDestFolder = objWatchFolder.Folders("foldername")
Change the delete to move
If objVariant.Subject = Item.Subject And objVariant.SentOn < Item.SentOn Then
objVariant.Move objDestFolder
Else
End If
Luke says
Hi Diane,
Apologies but I do not know what I am doing here.
If I have the subject of email as 'Intra-Day' and I want to move it from inbox to a folder which the path to it is 'Inbox>>Folder>>SubFolder1>>DestinationFolder' how would the whole macro look like?
I am struggling with what I need to swap in your script.
Thanks
Luke
Diane Poremsky says
You can do it two ways. In one long command - not recommended because of the number of dots in the commands.(It's a VB issue with the objects)
Set objDestFolder = objWatchFolder.Folders("Folder").Folders("Subfolder").Folders("DestinationFolder")
Or split per folder. Using this method, if you were using 2 different subfolders, you would use another folder object name for the intermediary folder.
Set objDestFolder = objWatchFolder.Folders("Folder")
Set objDestFolder = objDestFolder.Folders("Subfolder")
Set objDestFolder = objDestFolder.Folders("DestinationFolder")
The screenshot shows the location of the destination folder.
More information on folder paths:
https://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/

Gold Ram says
Hi Diane,
Is there a way where we can run a macro on a nightly basis where a Folder in Outlook is scanned and if the email received is older than 7 days old it, that email is forwarded to a few people for follow up?
Diane Poremsky says
You can use tasks and another macro to call this macro on a schedule, but outlook needs to be open for it to run.
Gold Ram says
Hi Diane,
Thank you for your prompt response. How would I do that?
Under tasks? Is there a custom macro that I need to build and would you please send me the macro code in VBA to write? or is it available through the Outlook Wizard?
If there's already another macro like this, would you please direct me to it? I've spent a very long time searching for it.
Thanks!
Pintu D. says
Hi Diane,
I need to move email based on userdefine properties available on excel
i am getting "Run time Error - 2147221233 (8004010F)" The operation Failed
while looping email from Outlook could you please help on Below code
*********************************************************************************************
Set filterItems = Folder.Items.Restrict(filterCriteria)
For Z = filterItems.Count To 1 Step -1
*** error on this Line**** Set msg = filterItems.Item(Z)
Debug.Print msg.Subject
Debug.Print msg.ReceivedTime
'
For k = 1 To InputB_Lastrow - 1
If msg.UserProperties.Find("SP ID") Is Nothing Then Exit For
If Keyword_Array(k) = "" Then Exit For
If msg.UserProperties.Find("SP ID").Value = UCase(Keyword_Array(k)) Then
' If InStr(1, UCase(msg.UserProperties.Find("SP ID")), UCase(Keyword_Array(k))) >= 1 Then
msg.Move myDestFolder
'MsgBox msg.Subject
rwcount = Sheets("Email_Moved").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
Sheets("Email_Moved").Range("A" & rwcount).Value = olFldr
Sheets("Email_Moved").Range("B" & rwcount).Value = msg.Subject
Sheets("Email_Moved").Range("C" & rwcount).Value = Keyword_Array(k)
' End If
End If
Next
Thanks,
Pintu.
Pintu D. says
Hi Diane any update?
Mario B. says
Hi Diane,
Is it possible to color code mails in the inbox that have a certain age ?
I know conditional formatting allows coloring of mails that are x days old, but I need the coloring to occur when the mails are x hours old.
Is there any way to achieve this using VBA ?
Thanks,
Mario
Diane Poremsky says
No. You'd need to use a macro to set a category then color based on the category. (But I'm going to try a few things and see if i can get it working.)
Wojciech Pluta says
Hello. Many thanks for this. It helped me a lot. I can now move old inbox items to folder one step above INBOX. I added macro autostart to my outlook shortcut so it is running daily with Outlook startup.
If anyone would need to use folder not under Inbox (my company policy sucks...), just change the line like this and rename xxx with your folder name.
' use a subfolder under InboxSet objDestFolder = objSourceFolder.Parent.Folders("xxx")
I am now trying to do the same with Sent items.
For source folder I use
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderSentMail)But I got stock when I would like to move it to a sub folder undrer my "xxx" folder name archive but I failed. Could you please help me to get things right?
`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(olFolderSentMail)
' use a subfolder under Sent
objSourceFolder.Parent.Folders ("PSA documentation\Sent")
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 120 days, adjust as needed.
If intDateDiff > 120 Then
objVariant.Move objDestFolder
'count the # of items moved
lngMovedItems = lngMovedItems + 1
kurt says
So moving within the same location (such as the server) (the 1st method) work but when i try to move the mails to a different data file, an Error pops up ; "Compile Error : Sub or Function not defined". Please see attached image.
Tell me how to solve this issue please.
TĂ¼mer says
Hi Diane,
thank you for code, ı little bit change for sent item folder. code is working but only my mail name is displaying, because of I'm sender.
how can ı change/ update code for "TO" recipient
"myRecipientName " am ı make wrong ?
Sub sentmovedAgedMail()
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(olFolderSentMail)
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 40 days, adjust as needed.
If intDateDiff > 100 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
myRecipientName = objVariant.SentOnBehalfOfName
If myRecipientName = ";" Then
myRecipientName = objVariant.RecipientName
End If
On Error Resume Next
Set objDestFolder = objSourceFolder.Folders(myRecipientName)
If objDestFolder Is Nothing Then
Set objDestFolder = objSourceFolder.Folders.Add(myRecipientName)
End If
objVariant.Move objDestFolder
'count the # of items moved
lngMovedItems = lngMovedItems + 1
Set objDestFolder = Nothing
End If
End If
Next
' Display the number of items that were moved.
MsgBox "Moved " & lngMovedItems & " messages(s)."
Set objOutlook = Nothing
Set objNamespace = Nothing
Set objSourceFolder = Nothing
End Sub
Nick says
Thanks so much Diane for this! I was looking for "VBA Macro to Move Aged Email Messages". I am looking at moving all emails ONLY from Inbox older than 22 days automatically to a folder "TO-DO/Follow Up" under the root mailbox folder parallel to Inbox (not a subfolder of Inbox). How do I set this as the destination folder?
Diane Poremsky says
Sorry I missed this earlier.
This does the inbox:
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
This does the age - change it to 22
' I'm using 7 days, adjust as needed.
If intDateDiff > 22 Then
For a folder at the same level, use
Set objDestFolder = objSourceFolder.Parent.Folders("TO-DO/Follow Up")
Brad says
Hi -
I have code similar to yours to archive emails to a pst. It worked great for several years until sometime last year, about when our exchange server was upgraded. It seems it will not work if Outlook is using cached mode but does work if not in cached mode. The vba error is "cannot move item"). I don't know if the exchange upgrade is the cause or it's some other update on my pc; Kind of think the former as I've since gone from Win 7 to Win 10 and still an issue. Outlook 2013 on Windows 10 accessing Exchange 2013.
Appreciate any thoughts or input you might have.
Diane Poremsky says
Definitely shouldn't be erroring. I've seen weird behavior like this with imap accounts - the item cant be moved because it's changed and the change needs to sync. Since it works in online mode, I'm wondering if there are permission issues with the ost. I would probably delete or rename the ost - outlook will make a new one.
Juan G says
Hi Diane. This is great. Do you know of a way that I can automate moving mail from folders in the inbox when item count is X. I will like to keep the item count within the Folders to 100,000. Thanks
Diane Poremsky says
Macros can count but you'll need to run it on a schedule - at startup might be the best, or call it daily or weekly using a reminder.
sub test()
Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objInboxFolder = objNamespace.GetDefaultFolder(olFolderInbox)
if objInboxFolder .items.count = 100000 then
call MoveAgedMail
end if
end sub
Santhosh says
Hi Diane,
Thank you for the simple code written under "VBA Macro to Move Aged Email Messages" section.
Kindly can you help me in using the code to act on all folders including sub-folders in Inbox to move to the folder old.
My scenario: I have my personal and a office mailbox used in the outlook and i want all the older emails>180days(including from sub-folders of Office mailbox)to be moved to a separate folder.
I used your code above but it only succeeds in moving the emails from Inbox(excluding the search from its sub-folders).
Hope you understand my issue and appreciate your kindest response at your earliest convenient time.
Please also consider that I am very new to VB and am just trying to learn it on new.
Many thanks in advance....!!!!!!
Diane Poremsky says
You need to walk the subfolders - there is a macro in https://www.slipstick.com/developer/print-list-of-outlook-folders/ named Sub ProcessFolder(CurrentFolder As Outlook.MAPIFolder) that does this. You need to put it together with the one you want to use. If i have time today, I will work on it but you'll learn a lot about VBA by trying it yourself.
If you want the moved items to use the same folderpath under the "Old" folder, it's a bit more complicated, as you need to check for the folder and create it, if it does not exist. It's doable - just needs more code.
Santhosh says
I really appreciate you taking time to reply back to me and sure I will try my level best to try using the above steps and will let you know.
Once again very much appreciate your desire to help starters like me.
Thanks a lot for your help...!!!!!
daniel simons says
Hi Diane,
I have a list of email addresses in an excel file.
Is there a macro to search in "To", "cc" or body of the email items and move found email items from current folder to another folder.
Everyday there is a new list of 400- 800 different email addresses hence we cannot put a rule to it. i couldn't find a macro anything close to my requirement across the internet.
Diane Poremsky says
it would be possible to look up email addresses or sender display names and move them to a folder of the same name - same macros are here - https://www.slipstick.com/developer/file-messages-senders-name/
daniel simons says
Hi Diane,
Thank you, i have no knowledge on coding hence checking with you if you can draft this for me and share it here.
Here is the complete task which i would like to share it with you.
i have to search email addresses listed in a column of excel and find matching email items in outlook sent folder, subfolders and delete it.
*Email addresses might be in "to", "cc" or body of the email in sent folder/subfolders.
*The list of email addresses change every day and
*The list has close to 300 to 500 email addresses.
also please tell me if i should run this code in an excel vb or as an outlook module which can link to the excel workbook saved on desktop
Diane Poremsky says
You can run it either as an Outlook macro or an Excel macro but it might be less complicated to do it in Outlook, since you need to search the data file. It will be very slow either way. The macro at https://www.slipstick.com/developer/categorize-messages-using-contact-category/ shows how to search for items based on an email address.
I haven't tested this in your scenario (another customer uses it to delete contacts) - this is an excel macro
Sub DeleteSentitems()
Dim olApp As Object
Dim olNs As Object
Dim sentFolder As Object
Dim delSent As Object
Dim myItem As Object
Dim strAddress As String
Dim i As Integer
Sheets("Sheet1").Select
On Error Resume Next
Set olApp = CreateObject("Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
Set sentFolder = olNs.GetDefaultFolder(olFolderInbox)
Set delSent = sentFolder.items
strAddress = Cells(i, 1)
Set myItem = delSent.Find("[SenderEmailAddress]=" & strAddress)
If Not TypeName(myItem) = "Nothing" Then
myItem.Delete
End If
i = i + 1
Loop
Set olApp = Nothing
End Sub
daniel simons says
Hi Diane,
I got error in both applications
excel: compile error: loop without do
outlook compile error: sub or Function not defined
Diane Poremsky says
>> outlook compile error: sub or Function not defined
what lines does it error on? It needs tweaked to work in outlook - you need to reference excel. The macro at https://www.slipstick.com/developer/vba-copy-outlook-email-excel-workbook/ shows how to access excel from outlook.
>> excel: compile error: loop without do
I trimmed too much from the macro - you need to add these two lines right before strAddress = Cells(i, 1)
i = 2
Do Until Trim(Cells(i, 1).Value) = ""
Brandon says
Hey Diane!
This looks amazing. I want to be able to move my emails to folders after I respond to them. Though I don't know how to use macros or code... at all. Do you have any suggestions to where I can start learning. This looks somewhat advanced for me.
Cheers!
Brandon
Diane Poremsky says
You should take a look at auto-mate - it's a rules engine that can move mail after you reply. To do it using a macro would require you run the macro every so often to process the mail. The other option is moving it as it arrives then use an unread search folder so you can see the new messages.
http://www.pergenex.com/auto-mate/index.shtml
Nick says
Very Helpful!
One question, how can we use your "Move messages to a different data file" code on say Inbox plus all the sub folders in the inbox?
I have it working perfectly with moving E-mails that are over 60 days old to Old Emails folder, but I need the code to run on sub folders as well.
You may very well save my life if this is possible :-)
Diane Poremsky says
it needs to walk the folder - i'll see if i have code that does it. Do you want it going into a subfolder when its moved?
Xena says
Hello Diane,
I have the same problem/question.
In my scenario I would want to search for old mails in all subfolders below Inbox and move them to a pst file with the original folder structure. Also if the destination folders do not yet exist they should be created automatically.
Thank you!
Naeem Ahmed says
Hi Diane,
what is the VBA code to search a mail with specific subject line and delete it in outlook.
Diane Poremsky says
if instr(1, objVariant.subject, "your word or phrase") > 0 then
objVariant.delete
end if
Patrick says
Diane, Your site is a fantastic resource! Truly heaven sent.
Just a quick question if you got time: I'm trying to use the MoveAgedMail2() macro and the macro gets stuck on this line:
Set objDestFolder = GetFolderPath("patricks\Archives inbox") with a "Compile error: Sub or Function not defined". GetFolderPath is highlighted in blue.
My PSTs are all in the same location (\AppData\Local\Microsoft\Outlook) and folder name is Archives inbox within patrick.pst Any idea how I might be able to resolve this? Thanks very much!
Diane Poremsky says
You need the getFolderPath function here -
https://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/#GetFolderPath
(Sorry I missed this earlier.)
Eric Peterson says
Hi Diane,
I'm looking for a way to move emails with specific subjects from the Inbox to a subfolder after 7 days. (Example sender: "[random]@amazonses.com" Subject: "Camera 1 Detected Movement.") They have to remain in the inbox upon receipt so the Android mail client will alert and so they are more noticeable in Outlook, but then after 7 days I would like them moved to a subfolder for short term archiving (30 days), then automated deletion using standard Outlook rules. Can the above macro be tweaked to do this? Can the macro use an OR statement to filter multiple emails by subject into the short term archiving folder? (Example Subject="Camera 1 Detected Movement" OR Subject="Camera 2 Detected Movement")
Can the above macro also be tweaked to process mail from specific senders the same way? (Example sender: "newsletter@abc123.com" subject:[Random])
Diane Poremsky says
You can do anything using If statements - either nested as additional statements or merged into one.
If intDateDiff > 7 Then
if instr(1, objVariant.subject, "Detected Movement) > 0 AND objvariant.senderemailaddress = "alias@domain.com" then
You will need to run the macro (or trigger it using reminders).
Ray says
Diane
Is there any way for a warning to pop up if a group of emails in your sent items or inbox is 80 days old? With maybe being able to select a server folder or from a previous list of folders as to where to save the message and attachment as a .msg file with date and message name?
Ray
Ayush Gaur says
Hi All,
Can anyone please help me, I really like the above script but it does not solve my purpose. I actually need difference in time instead of date.
Do we have anything which can help me to create a column in outlook view to show the time difference of current time and received time.
Diane Poremsky says
as in hours or minutes? This line does the calculations - intDateDiff = DateDiff("d", objVariant.SentOn, Now) - try changing the "d" to "h" and see if it works. Minutes is "n". This will move the messages (or you could categorize them)
If you just need the difference in a custom field - see https://www.slipstick.com/outlook/contacts/calculate-the-age-of-contact/ for one example. Instead of the birthday, you'll use the received time field. This method will update the fields as time passes (when you leave the folder and return).
Ayush Gaur says
Thanks Diane, It works perfectly.
Ayush Gaur says
I am able to get this column to work but however when i try the conditional formatting part or if i want to categorize them it is not able to find the column in the user defined fields.
Also i juist need this for the mails in the inbox, such that when the timer hits 60 min, it says that the mail has breached. i am able to achieve this by another column but the problem however is that my rule says that if Age >60 then it says breached.
I need to update something in the mail so that at the end of the day or month when i want to check which mails actually breached in the inbox it gives me the exact result.
Diane Poremsky says
Categories should be in the all mail fields. if you need to tag messages you'll need to run a macro on the messages in the inbox on a regular schedule.
I have this macro which uses a reminder - https://www.slipstick.com/outlook/rules/run-script-rule-watch-updates/ - but it relies on a follow up message.
Diane Poremsky says
BTW, if you wanted to use a custom field, this formula will work - DateDiff("n",[Received],Now()) - n = minute, h = hour.
Nik says
Hello
Here is what I set up and worked very well
Sub MoveAgedMail()
Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objInboxSourceFolder 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 objInboxSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
' use a subfolder under Inbox
Set objDestFolder = objInboxSourceFolder.Folders("JM")
For intCount = objInboxSourceFolder.Items.Count To 1 Step -1
Set objVariant = objInboxSourceFolder.Items.Item(intCount)
DoEvents
If objVariant.Class = olMail Then
intDateDiff = DateDiff("d", objVariant.SentOn, Now)
' I'm using 90 days, adjust as needed.
If intDateDiff > 90 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
here is the Folder structure on my outlook
I want to work with 2 folder ,All I want to do is move older than 90 day Email from Inbox and Sent Items to another folder (not sub folder under inbox) call "2 years" which has 2 sub folder called Inbox and Sent Items
So
Inbox to "2 Years" sub-folder called 'Inbox
Sent Items to "2 Years" sub folder called 'Sent Items'
Also need to put on quick access toolbar
Please Please some one help
Will says
That'll work, and easy too! Thank you very much for this simple (and quick!) addition :-)
Will
Will says
Once again without TYPOS... Sorry :-)
Dear Diane,
my name is Will. I have checked many of your Macro VBA Code here, but I am looking for a Macro that will enable the User to simply drag and drop (or maybe hit a button) an eMail from his INBOX to his Harddrive and not COPY it, but MOVE it. So the eMail must be DELETED in the INBOX or any Subfolder of the INBOX after copying (moving) it to a designated folder on his Harddrive. Is that possible?
Thank you so much in advance.
Will
Diane Poremsky says
The dragging part is difficult to impossible in a macro, but a macro can save to the hard drive then delete... simply add
omail.delete right after the save line in these macros https://www.slipstick.com/developer/code-samples/save-selected-message-file/
marius says
hi, in a shared office inbox, how can i move aged emails from a folder to another folder ? thank you.
Diane Poremsky says
You'll need to use the Move command, copy and paste, or drag & drop.
Diane Poremsky says
Oops, I bet you mean with the macro.
You need to repoint these to the correct folder.
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
Set objDestFolder = objSourceFolder.Folders("Old")
You might be able to use the GetFolderPath function at https://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/. You'll replace the lines above with
Set objSourceFolder = GetFolderPath("New PST\Inbox")
Set objDestFolder = GetFolderPath("New PST\Inbox\Old")
Shared mailboxes can also use code like this snippet:
Dim NS As Outlook.NameSpace
Dim objOwner As Outlook.Recipient
Set NS = Application.GetNamespace("MAPI")
Set objOwner = NS.CreateRecipient("maryc")
objOwner.Resolve
If objOwner.Resolved Then
'MsgBox objOwner.Name
Set objSourceFolder = NS.GetSharedDefaultFolder(objOwner, olFolderInbox)
Set objDestFolder = objSourceFolder.Folders("Old")
George P says
Hi, I'm stuck as I have used the MoveAgedMail macro however I need to automatically trigger the macro every time outlook 2010 opens. I apologize if I missed the instruction within this thread.
I search and found the following
Under ThisOutlookSession - Private Sub Application_Startup() End Sub
and my MoveAgedMail is under Modules
This is not working and I'm wondering if someone can help me. Thank you in advance!
Diane Poremsky says
This should work in ThisOutlookSession. If you click in it and click Run does it run the move aged mail macro?
Private Sub Application_Startup()
MoveAgedMail
End Sub
Marjory Montgomery says
Hello Diane,
You mention in this article about "use AutoArchive, set to run every 1 day and configure the Inbox archive setting to the desired number of days. ". Well that doesn't work for Outlook 2013 as AutoArchive only runs when Outlook is started. I start Outlook on Monday and leave it up for the work week - closing it on Friday.
Do you know of any way to create an AutoArchive task for the scheduler or a macro I could use? Right now I'm using a reminder to go run archive manually.
This all started when Conversation History from Lync was limited to a 7 day retention. We can archive them but we can't keep on server for more 7 days.
Diane Poremsky says
Correct, AutoArchive only runs when outlook is open. Macros will also only run when outlook is open. If you set AutoArchive to run daily and set the conversation history folder to be archived at 1 day of age, conversations will only be no more than 2 days old when archived - add 2 days for the weekend, and you'll be covered as long as you aren't out sick or on vacation.
Now... you could use a macro to watch the folder and move conversations as they are added to the folder. You'll need to change just the folder paths in this macro: https://www.slipstick.com/developer/save-appointments-to-a-non-default-calendar-folder/
Set newCal = NS.GetDefaultFolder(olFolderInbox).Parent.Folders("Conversation History").items
' Get the getfolderpath function and use this to move to a pst file
Set CalFolder = GetFolderPath("datafile-display-name\Conversation History")
if you can keep on the server but not in conversation history, you can use this to move them to a subfolder under the inbox called "Lync"
Set CalFolder = NS.GetDefaultFolder(olFolderInbox).Folders("Lync")
Kelly says
Hi Diane,
This thread has been tremendously helpful since I'm new to both Outlook and VBA. Is there a way to modify this macro so that it sends aged emails from the inbox to OneNote?
Diane Poremsky says
In Outlook 2010, possibly, but I'm not sure about newer versions. I'll take a look.
Kelly says
Probably should've mentioned that I'm using Outlook 2013. Thanks for looking into this!
Dan says
Good morning Diana,
Somehow, I cannot post the comment, I will try again thru Google account:
Greetings Diana,
Many thanks for the developed Macro to Move Aged Email in Outlook. I found it very useful in the past. These days I am in need of a different approach. Can you please advise as to if there is possibility to run auto-archiving or move aged email in outlook that were created, replied and / or forwarded in a chain. I got a PST achieve folder with another row of subfolder such as Well intervention, Purchase Orders, ISM etc. What needs to be used in order to move email messages from inbox and sent items to those subfolders? Something like grouped by conversations. Is it possible to do via email ID? Or message ID?
Diane Poremsky says
It posted, but I haven't had time to reply to the more complicated question. I leave them in the moderation queue until I'm ready to answer, otherwise they get lost. :(
I will have to investigate it - I don't think email id will work, but we might be able to get the conversation id.
Gaurav Khanna says
Hi Diane
I have got it working fine for me, though during testing i noticed one thing. May be you can help. Can we calculate the difference of only working days rather than all days. I am assuming some changes needed in following code:
intDateDiff = DateDiff("d", objVariant.SentOn, Now)
Also, is there a way that when the mail will be forward, I can add 1st reminder before the original subject line.
please help me with these last 2 requirements :-)
Thanks a lot in advance and have a wonderful day ahead.
Diane Poremsky says
Adding text to the subject is easy - counting working days is harder as there is no reliable way to account for weekends. We can test for the day of the week (using vbSunday, vbSaturday) when we are setting a date, but it's more difficult to remove then when counting as outlook doesn't support workdays. I have a NextWeekDaySeries function series which can be used when setting dates or counting but right now I can't wrap my head around how to use it in this situation.
this goes between the forward line and send:
myForward.subject = "1st reminder" & objVariant.subject
Diane Poremsky says
ok... i goofed on the subject code - it's myForward.subject = "1st reminder" & objVariant.subject
and this might work - wrapping my head around date calculations this early in the morning leaves it open for errors. :)
Dim sentDate As Date
sentDate = objVariant.SentOn
Select Case Weekday(sentDate, vbUseSystemDayOfWeek)
Case vbSunday
sentDate = DateAdd("d", 1, sentDate)
Case vbSaturday
sentDate = DateAdd("d", 2, sentDate)
Case vbFriday
sentDate = DateAdd("d", 2, sentDate)
Case vbThursday
sentDate = DateAdd("d", 2, sentDate)
End Select
Derrick says
Hi Diane,
I am pretty new to vba, and I am trying to adapt your code to move emails that have more than one pdf attachment to another folder instead of the aged mail criteria. I am running into some trouble with the code below as it is not looking at each email's pdf count, but rather the whole folder and moving everything due to the whole folder total. Would you be able to provide any insight into this, so the code will move emails with more than 1 pdf and leave emails with just 1 pdf alone? Thank you!
Sub MoveAgedMail()
Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objSourceFolder As Outlook.MAPIFolder
Dim SubFolder As Outlook.MAPIFolder
Dim objDestFolder As Outlook.MAPIFolder
Dim olkItem As Outlook.MailItem
Dim olkAttachment As Outlook.Attachment
Dim FileName As String
Dim objVariant As Variant
Dim lngMovedItems As Long
Dim intCount As Integer
Dim intDateDiff As Integer
Dim strDestFolder As String
Dim iExt As Long
Dim validExtString As String
Dim validExtArray() As String
Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
Set SubFolder = objSourceFolder.Folders("myFolder")
' use a subfolder under Inbox
Set objDestFolder = objSourceFolder.Folders("Test")
For intCount = SubFolder.Items.Count To 1 Step -1
Set objVariant = SubFolder.Items.Item(intCount)
DoEvents
If objVariant.Class = olMail Then
validExtString = ".pdf" '
validExtArray = Split(validExtString, " ")
Dim i As Integer
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders("myFolder")
i = 0
For Each olkItem In SubFolder.Items
For Each olkAttachment In olkItem.Attachments
strFilename = olkAttachment.FileName
lngExtIndex = InStrRev(strFilename, ".")
strBaseFilename = Left(strFilename, lngExtIndex - 1)
strExtension = Mid(strFilename, lngExtIndex)
For iExt = 0 To UBound(validExtArray)
If LCase(strExtension) = LCase(validExtArray(iExt)) Then
cnt = cnt + 1
Exit For
End If
Next iExt
Next olkAttachment
Next olkItem
' intDateDiff = DateDiff("d", objVariant.SentOn, Now)
' I'm using 7 days, adjust as needed.
If cnt > 1 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
Diane Poremsky says
I don't see where you are getting the attachment count on each message. You're using for each but that doesn't resetting the count to 0. I would probably use attachments.count instead. This will reset it each time.
For Each olkItem In SubFolder.Items
For Each olkAttachment In olkItem.Attachments
Gaurav Khanna says
Diane.....it worked atlast. I figured out the error. My bad....i messed in pasting your code.
Thanks a lot for your help Diane. You are awesome. One last query, what should I add/modify to ensure that this code covers all subfolders in the inbox. As at times mails are lying there as well.
Once again, thanks a ton for your help Diane.
Diane Poremsky says
You'll need to walk the folders to set the source folder - I have one example at https://www.slipstick.com/developer/print-list-of-outlook-folders/
Gaurav Khanna says
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
Diane Poremsky says
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.
Diane Poremsky says
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("https://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
Gaurav Khanna says
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.
Diane Poremsky says
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.
Gaurav Khanna says
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.
Diane Poremsky says
As configured, it runs on the default inbox in your profile. You said its for a non-default inbox?
See https://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/ for the code needed to watch other folders.
Gaurav Khanna says
Hi Diane
I am sorry for all this mess, and i am really thankful for your patience in helping me out.
Well this doesnt work either.
So I will try to explain it once again. I have a generic mailbox on exchange server. Mailbox Name is "[SH]-GL-CEVA-GLOBAL-JOURNALCGL". I want a rule to run on this mailbox, which checks all emails in Inbox & its subfolders only and forward all emails which have been replied/replied all for last 7 days to g.khanna@accenture.com (my email id).
I need it to keep a track on the mails which have been handled or not.
Similarly, I want to extend this rule to send these emails to my manager email ID, lets say g.khanna1@accenture.com, in case the mails havent been replied/replied all for 14 days.
I used your first code, and tried to understand it. Though I am not very good in these codes, and still learning. I am sure using such codes will make my life easier and smart.
Appreciate all your efforts in helping me out.
Thanks
Gaurav
Diane Poremsky says
I published a macro that does this last night - https://www.slipstick.com/developer/code-samples/forward-messages-not-replied/ (I've had a few people ask for this ability.)
For the folder path, is the mailbox in your profile as a full mailbox? if so, replacing this line
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
with this one should work. You need the getfolderpath function or the GetSharedDefaultFolder code on the same page.
Set objSourceFolder = GetFolderPath("[SH]-GL-CEVA-GLOBAL-JOURNALCGL\Inbox")
Gaurav Khanna says
Diane
I have gone through it, it looks pretty good to me. Just wondering can we also customize it to calculate the ageing on hours, and not days. Though thats not my requirement, just for info sake.
As per your suggestion, I have used the following function for getfolderpath from your forum page, not sure if it is right though.
Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
Dim oFolder As Outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer
On Error GoTo GetFolderPath_Error
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array
FoldersArray = Split(FolderPath, "\")
Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.Item(FoldersArray(i))
If oFolder Is Nothing Then
Set GetFolderPath = Nothing
End If
Next
End If
'Return the oFolder
Set GetFolderPath = oFolder
Exit Function
GetFolderPath_Error:
Set GetFolderPath = Nothing
Exit Function
End Function
When I run this now, I am getting a debug error in
For intCount = objSourceFolder.Items.Count To 1 Step -1
Diane Poremsky says
I'm not sure why that line would be erroring - unless the Dim statement isn't there?
Dim intCount As Integer
This line: intDateDiff = DateDiff("d", objVariant.SentOn, Now) controls the value that is checked. "h" = hour. I see no reason why it won't work.
Diane Poremsky says
Oh, I wonder if the source folder isn't found?
David Kellie-Smith says
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
Diane Poremsky says
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")
https://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/
Daniel Pham says
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.
Diane Poremsky says
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?
Haizhou says
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,
Diane Poremsky says
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 https://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
Haizhou says
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?
Diane Poremsky says
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 - https://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/
Murali Krishna says
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??????
Diane Poremsky says
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?
Diane Poremsky says
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
Douglas says
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 ]
Diane Poremsky says
You need to loop through the folders. I have two samples - https://www.slipstick.com/developer/print-list-of-outlook-folders/ and https://www.slipstick.com/developer/saving-messages-to-the-hard-drive-using-vba/ that show how to loop through subfolders.
Adam says
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!
Diane Poremsky says
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).
John says
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?
Diane Poremsky says
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")
https://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/
kyaa21 says
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
Diane Poremsky says
You can do that, you need a function that goes though each folder. I'll see if i can find the function.
John says
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
Diane Poremsky says
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. :)
Ed says
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
Diane Poremsky says
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.
Michael MuselĂk (@MichaelMuselik) says
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
Diane Poremsky says
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")
Sorin says
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
Diane Poremsky says
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.
Sorin says
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.
Diane Poremsky says
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 https://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.
Glenn Case says
THanks!
Glenn Case says
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.
Diane Poremsky says
I have no idea why it suddenly because an issue. For learning vba, Outlookcode.com has tutorials as does MSDN.
Karen says
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)
Diane Poremsky says
The thread is here - https://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
Karen says
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.
Diane Poremsky says
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)
Diane Poremsky says
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
Diane Poremsky says
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.
Karen says
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 :)
Diane Poremsky says
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
Karen says
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.
Karen says
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 (https://www.vboffice.net/en/developers/get-the-message-folder) 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
Diane Poremsky says
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.
Eduardo Carvalho says
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!
Diane Poremsky says
Did you add the GetFolderPath macro to the module? https://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/
Merdan Bayramov says
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
Diane Poremsky says
This works here, in Outlook 2010:
If intDateDiff > 7 And objVariant.SenderEmailAddress = "alias@domain.com" Then
Adam says
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?
Diane Poremsky says
If intDateDiff > 7 AND If objVariant.sender = "alias@domain.com" Then
Should work. If Outlook 2013, objVariant.senderemailaddress should work too.
Rob says
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...
Diane Poremsky says
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.
Eduardo Carvalho says
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!!
Diane Poremsky says
The new code sample is at #newpst - you'll need to change the pst path in the macro and get the function.
Eduardo Carvalho says
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.
Diane Poremsky says
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.
Ă–rjan Kihlbaum says
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,
Diane Poremsky says
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.Diane Poremsky says
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
James says
Worked like a charm! Thank you for the assistance! This has been a good learning experience.
James says
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?
Diane Poremsky says
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
James says
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?
Diane Poremsky says
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.
Gilad says
Thanks.
I will try this...
Gilad says
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?
Diane Poremsky says
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.
Diane Poremsky says
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.
Gilad says
Thanks.
Is there a generic macro that I can use?
Diane Poremsky says
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.
Gilad says
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...
Diane Poremsky says
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.
Gilad says
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").
Diane Poremsky says
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.
AJ says
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.
Pennie says
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
Diane Poremsky says
try using senderemailaddress here instead of sender:
If objVariant.Sender = "me@me.com" Then
Woodgrain says
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!
Diane Poremsky says
It should work fine with Outlook 2007. It works with the default email account, so it should work fine with your exchange account too.
Chuck Etheridge says
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.
Diane Poremsky says
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.