VBA Repeats tasks multiple times

[djfatboyfats]

Good morning,

I have codes in VBA within my workbook that repeat their tasks multiple times when I only want them to run once at the specific time.
The code below refreshes by data at 9pm at night then runs another on time event to send the range by email at 9:15, sometimes i get 1 email, some days 4 emails and yesterday I got 6 emails with the same data. I think every time I close the workbook in the day and reopen it it keeps another event in the memory and then repeats the task, yesterday I closed the workbook around 6 times and got 6 emails yesterday night at 9:15. Does anyone know how to fix this problem so the task only runs once?

Private Sub Workbook_Open()
     Application.OnTime TimeValue("21:00:00"), "Refresh_All_Dialler"
     Application.OnTime TimeValue("21:15:00"), "Email_Todays_Deals"
     End Sub

Sub Email_Todays_Deals()
Sheets("Daily Update").Select
   ' Select the range of cells on the active worksheet.
   With Sheets("Daily Update").Range("A1:O66")
   ActiveSheet.Range("A1:O66").Select
   End With
   ' Show the envelope on the ActiveWorkbook.
   ActiveWorkbook.EnvelopeVisible = True
   
   ' Set the optional introduction field thats adds
   ' some header text to the email body. It also sets
   ' the To and Subject lines. Finally the message
   ' is sent.
   With ActiveSheet.MailEnvelope
      .Introduction = "Data From DJ Database"
      .Item.To = "[email protected]"
      .Item.CC = "[email protected]"
      .Item.Subject = "[Auto Mailer] - Dialler Statistics - " & Format(Date, "ddmmyy")
      .Item.Send
   End With
End Sub

Thanks in advance

[buran]

Hi,
try this

Private Sub Workbook_Open()

'Cancel any previous scheduled run
    On Error Resume Next
    Application.OnTime TimeValue("21:00:00"), "Refresh_All_Dialler", , False
    Application.OnTime TimeValue("21:15:00"), "Email_Todays_Deals", , False
    On Error GoTo 0

'Add scheduled run again
    Application.OnTime TimeValue("21:00:00"), "Refresh_All_Dialler"
    Application.OnTime TimeValue("21:15:00"), "Email_Todays_Deals"
End Sub

Buran

[djfatboyfats]

Ok thank you, i will try it today and let you know if it works.


Thanks

DJ

[djfatboyfats]

That seems to have done the trick, Thanks