Macro for Office 2016 - Move emails

[Caldasso]

Hello People

First, sorry for my english. I'm from Brazil.

I need a macro that moves emails based on their age.

Currently, my outlook looks like:

Exchange configuration

Inbox
|- subfolder 1
|- subfolder 2
|- subfolder 3
|- subfolder 4
|- subfolder 5
|- subfolder 6
|- subfolder 7

I receive emails in all folders, both in the inbox and in the subfolders.

I also have a data file (PST) with the same "format" as above. That is, as if it were a mirror ... however, this recorded place on the disc.

So I need a macro, which when I activate it, check all the exchange folders and move all emails older than 30 days into their local folders.

Someone of good heart, can you please help me?

[Logit]

.
https://www.slipstick.com/developer/macro-move-aged-mail/

[Caldasso]

.


Thanks man.

But...

I do not have just the inbox. I have the inbox and several other subfolders. Emails are distributed via "rules" for each of the subfolders.

Follow an image:
20786



So I need the macro to go from subfolder to subfolder by moving files over 1 month old to offline folders

[gmayor]

The following code will look through the sub folders


Sub Processfolders()
'Graham Mayor - http://www.gmayor.com - Last updated - 28 Oct 2017
Dim cFolders As Collection
Dim olFolder As Outlook.Folder
Dim subFolder As Folder
Dim olNS As Outlook.NameSpace
Set cFolders = New Collection
Set olNS = GetNamespace("MAPI")
cFolders.Add olNS.PickFolder
Do While cFolders.Count > 0
Set olFolder = cFolders(1)
cFolders.Remove 1

'Do something here with olfolder e.g.
Debug.Print olFolder.Name

For Each subFolder In olFolder.folders
cFolders.Add subFolder
Next subFolder
Loop
lbl_Exit:
Set olFolder = Nothing
Set subFolder = Nothing
Set olNS = Nothing
Exit Sub
End Sub

[Caldasso]

Gmayor

Friend, sorry for my ignorance.
But I do not understand how to use your code.


From what I understand, your code should be used next to the other higher, right?

[gmayor]

You need to call the other code from it e.g. as follows. I have not tested the code, just made a couple of modifications to it to work with the folders derived from the Processfolders macro. It saves in a sub folder of Inbox called "Old" which must exist.


Option Explicit
'Graham Mayor - http://www.gmayor.com - Last updated - 31 Oct 2017

Sub Processfolders()
Dim cFolders As Collection
Dim olFolder As Outlook.Folder
Dim subFolder As Folder
Dim olNS As Outlook.NameSpace
Set cFolders = New Collection
Set olNS = GetNamespace("MAPI")
cFolders.Add olNS.PickFolder
Do While cFolders.Count > 0
Set olFolder = cFolders(1)
cFolders.Remove 1
'Do something here with olfolder e.g.
MoveAgedMail olFolder
For Each subFolder In olFolder.folders
cFolders.Add subFolder
DoEvents
Next subFolder
Loop
lbl_Exit:
Set olFolder = Nothing
Set subFolder = Nothing
Set olNS = Nothing
Exit Sub
End Sub

Sub MoveAgedMail(objSourceFolder As Outlook.MAPIFolder)

Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
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")
'Tell the macro where to store the messages here a folder called "Old" under inbox
Set objDestFolder = objNamespace.GetDefaultFolder(olFolderInbox).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)

' Adjust days as needed.
If intDateDiff > 30 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

[Caldasso]

Gmayor,

Thanks so much.

I ran a test, and he actually moved some emails. But that's not quite what I need.


The problem is that in the past, all moved emails are falling into the folder called "OLD"


I need these emails to fall into their same folders, however, in the PST file. As per the image I attached above.


That is, all emails from the "DELL" subfolder in the exchange, should go to the "DELL" subfolder in the PST. The same for each subfolder.


It is possible?


Thanks again!