I have a macro which examines a public folder (we use exchange) and, for each sub-folder, moves the mailitems in the sub-folder further down the tree based upon the date the item was received.
Running the macro every day, manually, and all is well.
The macro only needs to be run once a day as the mail items are reports which are generated daily for the previous day's work.
The macro is
o_App As Outlook.Application, _
o_RechargeFolder As Outlook.MAPIFolder, _
o_ContractFolder As Outlook.MAPIFolder, _
o_YearFolder As Outlook.MAPIFolder, _
o_MonthFolder As Outlook.MAPIFolder, _
o_DayFolder As Outlook.MAPIFolder, _
o_Item As Outlook.MailItem
b_YMDFolder As Boolean, _
dt_Received As Date, _
i_Item As Integer, _
i_Items As Integer, _
s_RechargeFolderID As String
s_RechargeFolderID = "000000001A447390AA6611CD9BC800AA002FC45A030085FB38B65F840A438204B33E62CC2FC4000000169FB80000"
Set o_App = CreateObject("Outlook.Application")
Set o_RechargeFolder = o_App.GetNamespace("Mapi").GetFolderFromID(s_RechargeFolderID)
' Verify Recharge Folder.
If o_RechargeFolder.Name <> "Recharge Reports" Then
Prompt:="Folder is not the Recharge Reports folder." & Chr(13) & Chr(13) & "Selected folder is : " & o_RechargeFolder.Name, _
Buttons:=vbExclamation + vbOKOnly, _
Title:="ERROR : Invalid folder selected"
' Iterate the current contracts
For Each o_ContractFolder In o_RechargeFolder.Folders
' We ignore "Retired"
If "Retired" <> o_ContractFolder.Name Then
' Determine if we need to look at Year\Month\Day or Year only.
If "ASDA" = o_ContractFolder.Name Or "Hartshorne" = o_ContractFolder.Name Or "Hill Hire" = o_ContractFolder.Name Then
b_YMDFolder = True
b_YMDFolder = False
Debug.Print "Examining " & o_ContractFolder.Name
' Iterate the items.
i_Items = o_ContractFolder.Items.Count
i_Item = 0
' NOTE : Use a reverse for loop rather than for each as the pointer is updated to the next item immediately after the move and then Next skips an item.
For i_Item = i_Items To 1 Step of - 1
Set o_Item = o_ContractFolder.Items(i_Item)
Debug.Print "Processing item #" & i_Item & " of " & i_Items & " reports : " & o_Item.Subject
' Mark as read
If True = o_Item.UnRead Then
o_Item.UnRead = False
' File the reports generated today in yesterday's folder.
dt_Received = o_Item.ReceivedTime - 1
' Find the appropriate destination file
If b_YMDFolder = True Then
Set o_YearFolder = CheckFolder(o_ContractFolder, CStr(Year(dt_Received)))
Set o_MonthFolder = CheckFolder(o_YearFolder, Format(Month(dt_Received), "00"))
Set o_DayFolder = CheckFolder(o_MonthFolder, Format(Day(dt_Received), "00"))
Set o_DayFolder = CheckFolder(o_ContractFolder, CStr(Year(dt_Received)))
Function CheckFolder(o_Folder As Outlook.MAPIFolder, s_SubFolder As String)
Dim o_SubFolder As Outlook.MAPIFolder
Set CheckFolder = Nothing
On Error Resume Next
Set CheckFolder = o_Folder.Folders.Add(s_SubFolder)
On Error GoTo 0
If Not CheckFolder Is Nothing Then
Set CheckFolder = o_Folder.Folders(s_SubFolder)
From what I've been reading, the way to get this macro to run daily is to create a task with a reminder and then use Private Sub Application_Reminder(ByVal
Item As Object) to watch for that reminder and fire the macro.
Is this the only way? Is there a way to attach a macro to an event within Outlook's UI?
The macro is self-signed, so I don't get the popup/delay box about someone accessing the mail.