Outlook 2016 call to Stop Timer Event

Status
Not open for further replies.

finod

New Member
Outlook version
Outlook 2016 32 bit
Email Account
POP3
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.

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
 
If you know you´re going to send 500, then use a varible to count how many times Send has been called.

Thank you for your reply Michael. But the number to send varies so that will not work. However, I was thinking maybe I could use something like an IF statement:

'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
If Draft > 0 then
Next lDraftCount else
DeactivateTimer

I am new to this VBA stuff so I am not sure this is possible.
 
After the Next line, read drafts.count and if it´s 0, stop the timer.
 
After the Next line, read drafts.count and if it´s 0, stop the timer.

Thanks again for your help. This is the code I came up with. It compiled and I will try it later to see if it works.

Code:
'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
 
' Check Drats count for no more recores to process then stop timer.
  If Drafts.Count = 0 Then
        MsgBox "Timer deactivated."
    DeactivateTimer
  End If
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
farrissf Outlook 2016 Optimizing Email Searches in Outlook 2016: Seeking Insights on Quick Search vs Advanced Search Features Using Outlook 0
S Outlook 2016 and Acrobat PDFMaker Office COM Addin Using Outlook 0
W Outlook 2016 MSI - Possible to make work with O365 modern Auth & Win7? Using Outlook 4
J Outlook 2016 Trying to get Outlook 2016 to work with Office 365 Using Outlook 0
W Transfer Outlook 2016 autocomplete file to Outlook 2007 Using Outlook 1
J Outlook 2016 Can't display some embedded HTML images in Outlook 2016 Using Outlook 2
J Outlook 365 Outlook 2016/365 Contacts Lose Info when Favorited to the To-Do Bar Using Outlook 2
O Moving "tasks" to inbox in Outlook 2016 Using Outlook 1
Z Remove GMAIL IMAP account from Outlook 2016 Using Outlook 2
P Prevent Outlook 2016 from using DASL filter Using Outlook 4
bhamberg Shortcuts in Folder Pane (Outlook 2016) Using Outlook 19
G Outlook 2016: Want IMAP Data Files on My D: Drive and Not C: Drive Using Outlook 1
D Outlook 2016 64bit, Cannot Save in 'HTML', format Using Outlook 1
P Color Code or highlight folders in Outlook 2016 Using Outlook 2
B Outlook 2016 Unable to view images or logos on the outlook 2016 emails the same html code works well when i use outlook 2010 Using Outlook 0
B vBA for exporting excel file from outlook 2016 Outlook VBA and Custom Forms 3
M Issue transferring Outlook 2016 email accounts & settings onto new computer Using Outlook 8
glnz Can Word Normal.dotm interfere with Outlook? Office 2016 Using Outlook 5
D Outlook 2016 and Earlier with Office365 in 2021 Using Outlook 3
B Outlook 2016 Retail C2R keeps logging since update? Using Outlook 0
V Outlook 2016 Does Outlook-2016 (64 bit) work with iCloud for Windows ? Using Outlook 5
R Microsoft Outlook 2016 - Gmail not sending, asks for password for SMTP, tried different ports Using Outlook 23
V Outlook 2016 Outlook-2016 and iCloud for Windows - Problems Using Outlook 11
U Outlook 2016 Outlook 2016 sender name Using Outlook 1
S Outlook (2016 32bit; Gmail IMAP) - Save sent message to Outllook Folder Outlook VBA and Custom Forms 0
A Backup Email Accounts On OutLook For Mac 2016 (Microsoft 365 subscription version) Using Outlook 0
M Office 2016 Outlook is forgetting passwords Using Outlook 15
E Can one still buy Outlook (or Office) 2016? Using Outlook 6
I Error saving screenshots in a custom form in outlook 2016, outlook 365 - ok in outlook 2013, outlook 2010 Outlook VBA and Custom Forms 5
R seperate read layout to design in outlook 2016..Help!! Outlook VBA and Custom Forms 3
GregS Why is Outlook 2016 mail in Outlook.com? Using Outlook 1
G Recurring tasks break links Outlook 2016 Using Outlook 5
A How to get body of all emails in outlook 2016 to view in blue color Using Outlook 1
J Edit auto-complete list in Outlook 2016+/365? Using Outlook 0
D iCloud Add-in not working in Outlook 2013 and Outlook 2016 After Windows Upgrade & iCloud Upgrade Using Outlook 2
GregS Outlook 2016 iPhone won't download Outlook 2016 Mail. Using Outlook 0
E How to display "Change Folder" in Change Default Email Delivery Location in Exchange Outlook 2016 Using Outlook 1
A How to open a specific link automatically with outlook 2016 Outlook VBA and Custom Forms 6
V Outlook 2016 will not move emails in search results Using Outlook 4
K Using Outlook 2016 to draw Using Outlook 1
M Outlook 2016 Free/Busy settings ignored Using Outlook 0
K Outlook 2016 - controlling IMAP OST size with Group Policy not working Using Outlook 1
C Outlook 2016/2019 hangs after being open for an extended period Using Outlook 4
GregS 2016 Contact List being managed by Outlook.com? Using Outlook 1
A Outlook 2016 in Cached Mode Using Outlook 1
G Outlook 2016 sync contacts directly between phone and computer using outlook 2016 Using Outlook 0
N Outlook 2016 Folder Icons Look Using Outlook 0
Marc2019 Outlook 2016 Font Problem Using Outlook 5
B Outlook 2016 Does not Shutdown Correctly Using Outlook 3
GregS Outlook 2016 Outlook 2016 stalls Using Outlook 3

Similar threads

Back
Top