Having an Outlook 2003 SP3 macro run every day.

Hi.

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  

Sub SortRecharges()
    Dim _
        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
    Dim _
        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
        MsgBox _
            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"
        Exit Sub
    End If

    ' 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
            Else
                b_YMDFolder = False
            End If

            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
                End If

                ' 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"))
                Else
                    Set o_DayFolder = CheckFolder(o_ContractFolder, CStr(Year(dt_Received)))
                End If

                o_Item.Move DestFldr:=o_DayFolder
            Next i_Item

        End If

    Next o_ContractFolder

End Sub

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
    Else
        Set CheckFolder = o_Folder.Folders(s_SubFolder)
    End If
End Function

Select allOpen in new window

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.

Regards,

Richard Quadling.