How to run code every day with Application.OnTime-CodePudding

I created a macro that should check a certain mail folder for latest mail received with attachment between 08:00 - 10:30.

I want the VBA code to run every morning automatically. It works the first day, but it won't restart next day.

Sub AutoRefresh()
    Application.OnTime Now   TimeValue("00:02:30"), "Save_Attachment_GFI"  
End Sub

Sub Save_Attachment_GFI()
    
    Dim Olook As Outlook.Application
    Dim OMailItem As Outlook.MailItem
    Dim ONameSpace As Outlook.Namespace
    Dim Fol As Outlook.MAPIFolder
    Dim Atmt As Outlook.Attachment
    
    Set Olook = New Outlook.Application
    Set OMailItem = Olook.CreateItem(olMailItem)
    Set ONameSpace = Olook.GetNamespace("MAPI")
    Set Fol = ONameSpace.GetDefaultFolder(olFolderInbox)
    Set Fol = Fol.Folders("FFA")
    Set Fol = Fol.Folders("FFA GFI")
        
    For Each OMailItem In Fol.Items
        For Each Atmt In OMailItem.Attachments
            Atmt.SaveAsFile "C:XXX" & Atmt.Filename
        Next
    Next
        
    If Time > TimeValue("08:00:00") And Time < TimeValue("10:30:00") Then
        Call AutoRefresh
    End If

End Sub

CodePudding user response：

This should work:

Sub Save_Attachment_GFI()
    
    Dim Olook As Outlook.Application
    Dim OMailItem As Outlook.MailItem
    Dim ONameSpace As Outlook.Namespace
    Dim Fol As Outlook.MAPIFolder
    Dim Atmt As Outlook.Attachment
    Dim TimeStart, TimeEnd
    
    TimeStart = TimeSerial(8, 0, 0) 'define start and end cutoffs
    TimeEnd = TimeSerial(22, 30, 0)
    
    Set Olook = New Outlook.Application
    Set OMailItem = Olook.CreateItem(olMailItem)
    Set ONameSpace = Olook.GetNamespace("MAPI")
        Set Fol = ONameSpace.GetDefaultFolder(olFolderInbox)
        Set Fol = Fol.Folders("FFA")
        Set Fol = Fol.Folders("FFA GFI")
        
        For Each OMailItem In Fol.Items
            For Each Atmt In OMailItem.Attachments
                Atmt.SaveAsFile "C:XXX" & Atmt.Filename
            Next
        Next
        
    If Time > TimeStart And Time < TimeEnd Then
        AutoRefresh Now   TimeSerial(0, 2, 30)
    Else
        If Time < TimeStart Then AutoRefresh Date   TimeStart     '8am today
        If Time > TimeEnd Then AutoRefresh (Date   1)   TimeStart '8am tomorrow
    End If

End Sub

Sub AutoRefresh(when As Date)
    Application.OnTime when, "Save_Attachment_GFI"
End Sub