How to delay a macro that runs after sending email?

Question

I have the below code for Outlook 365 which will run a macro after sending an email.

How do I modify this to delay the macro 10 seconds after clicking send, and how do I limit this code to my exchange account email which is the default email account?

Option Explicit

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    With Item
        Call BatchResendEmailsMacro
    End With
End Sub

score 0 · Answer 1 · answered Mar 06 '21 at 14:54

Outlook doesn't have a timer function but you can use Appointment or Task Reminders to trigger macros. Set up an Application_Reminder macro that will do something when a reminder fires. To limit it to running when specific reminders fire, use an If statement to look for words in the subject or a specific category.

If you want the macro to fire a specified time after you restart Outlook, use an Application_Startup macro to create the appointment. Read more about that in the Running Outlook Macros on a Schedule article.

Also you may consider using Windows API functions such as SetTimer and KillTimer. Outlook VBA - Run a code every half an hour page provides a sample code (for example, that is for Windows x64):

Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongLong, ByVal nIDEvent As LongLong, ByVal uElapse As LongLong, ByVal lpTimerfunc As LongLong) As LongLong
Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongLong, ByVal nIDEvent As LongLong) As LongLong

Public TimerID As LongLong 'Need a timer ID to eventually turn off the timer. If the timer ID <> 0 then the timer is running

Public Sub TriggerTimer(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)
  MsgBox "The TriggerTimer function has been automatically called!"
End Sub


Public Sub DeactivateTimer()
Dim lSuccess As LongLong
  lSuccess = KillTimer(0, TimerID)
  If lSuccess = 0 Then
    MsgBox "The timer failed to deactivate."
  Else
    TimerID = 0
  End If
End Sub

Public Sub ActivateTimer(ByVal nMinutes As Long)
  nMinutes = nMinutes * 1000 * 60 
  'The SetTimer call accepts milliseconds, so convert to minutes
  If TimerID <> 0 Then Call DeactivateTimer 
  'Check to see if timer is running before call to SetTimer
  TimerID = SetTimer(0, 0, nMinutes, AddressOf TriggerTimer)
  If TimerID = 0 Then
    MsgBox "The timer failed to activate."
  End If
End Sub

score 0 · Answer 2 · answered May 29 '21 at 21:12

You could trigger the code with the ItemAdd event on the Sent Items folder.

Option Explicit

' In the ThisOutlookSession module

Private WithEvents sentItems As Items

Private Sub Application_Startup()
    
    Dim sentItemsFolder As Folder
    
    ' default Sent Items folder
    Set sentItemsFolder = Session.GetDefaultFolder(olFolderSentMail)
    
    Set sentItems = sentItemsFolder.Items
    
End Sub

Private Sub sentItems_ItemAdd(ByVal item As Object)
    
    Dim waitTime As Long
    Dim waitDiff As Long
    
    Dim delay As Date
    Dim waitStart As Date
    
    waitTime = 10    ' in seconds
    Debug.Print vbCr & "Wait start: " & Now
    
    waitStart = Now
    delay = DateAdd("s", waitTime, waitStart)
    Debug.Print "Wait until: " & delay
        
    Do Until Now >= delay
        DoEvents
    Loop
    
    Debug.Print "Wait end..: " & Now
    waitDiff = DateDiff("s", waitStart, Now)
    Debug.Print waitDiff & " seconds delay."
    
    Debug.Print "Call BatchResendEmailsMacro"
    'Call BatchResendEmailsMacro
    Debug.Print "Done."
    
End Sub

Private Sub test()
    sentItems_ItemAdd ActiveInspector.currentItem
End Sub

How to delay a macro that runs after sending email?

2 Answers2