I have VBA code in Access that sends email with attachments to about 500 veterans. My ISP has a limit of 100 email being sent at one time. My code creates all the email and then uses MyMail.Save which puts all the email into the Outlook 2016 Draft Folder.
The code below starts a timer event that runs every 25 minutes. It sends the first 98 emails and then waits until 25 minutes pass and sends the second batch of 98. It continues to run until all the emails in the Draft folder are sent.
All this works fine. When the last email batch is sent, I must manually STOP the timer by calling Stop Timer.
To fully automate my process, I would like for the STOP Timer to be called when there are no more Drafts to send. My problem is I am not sure the best way to code for the this to occur. Any suggesting will be appreciated.
The code below starts a timer event that runs every 25 minutes. It sends the first 98 emails and then waits until 25 minutes pass and sends the second batch of 98. It continues to run until all the emails in the Draft folder are sent.
All this works fine. When the last email batch is sent, I must manually STOP the timer by calling Stop Timer.
To fully automate my process, I would like for the STOP Timer to be called when there are no more Drafts to send. My problem is I am not sure the best way to code for the this to occur. Any suggesting will be appreciated.
Code:
'********* Stop Timer **************
Private Sub Application_Quit()
If TimerID <> 0 Then Call DeactivateTimer 'Turn off timer upon quitting **VERY IMPORTANT**
End Sub
'************ Start Timer **********
Sub StartTimer()
'First call macro to initially send fist round of drafts
SendDrafts
MsgBox "Activating the Timer."
Call ActivateTimer(25) 'Set timer to go off every 25 minutes
End Sub
'******************************* Module 1
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public TimerID As Long 'Need a timer ID to eventually turn off the timer. If the timer ID <> 0 then the timer is running
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
Public Sub DeactivateTimer()
Dim lSuccess As Long
lSuccess = KillTimer(0, TimerID)
If lSuccess = 0 Then
MsgBox "The timer failed to deactivate."
Else
TimerID = 0
End If
End Sub
Public Sub TriggerTimer(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)
'keeps calling every X Minutes unless deactivated
If idevent = TimerID Then
SendDrafts
'MsgBox "The TriggerTimer function has been automatically called!"
End If
End Sub
'******************************* Module 2
Public Sub SendDrafts()
Dim olApp As Outlook.Application
Dim NS As Outlook.NameSpace
Dim DraftsFolder As Outlook.MAPIFolder
Dim Drafts As Outlook.Items
Dim DraftItem As Outlook.MailItem
Dim lDraftCount As Long
Set olApp = Outlook.Application
Set NS = olApp.GetNamespace("MAPI")
Set DraftsFolder = NS.GetDefaultFolder(olFolderDrafts)
Set Drafts = DraftsFolder.Items
' *****************************************************************************
'Loop through all Draft Items
lstNumber = Drafts.Count - 97
If lstNumber < 1 Then
lstNumber = 1
End If
For lDraftCount = Drafts.Count To lstNumber Step -1
Set DraftItem = Drafts.Item(lDraftCount)
'Send Item
DraftItem.DeleteAfterSubmit = True 'Don't save a copy of sent email
DraftItem.Send
Next lDraftCount
' ********************************************************************************
'Clean-up
Set DraftsFolder = Nothing
Set NS = Nothing
Set olApp = Nothing
End Sub
