Sub SendHourlyEmails() On Error GoTo ErrorHandler ' Add error handling Dim startTime As Date Dim endTime As Date Dim intervalMinutes As Integer Dim currTime As Date Dim draftFolder As Outlook.MAPIFolder Dim draftItems As Outlook.Items Dim draft As Outlook.MailItem Dim draftCount As Integer Dim sentCount As Integer ' Set the start time, end time, and interval in minutes startTime = DateSerial(Year(Now()), Month(Now()), Day(Now())) + TimeSerial(22, 0, 0) ' 10 PM endTime = DateSerial(Year(Now()), Month(Now()), Day(Now()) + 1) + TimeSerial(5, 0, 0) ' 5 AM of the next day intervalMinutes = 60 ' 60 minutes ' Calculate the current time currTime = Now If currTime < startTime Then Application.Wait startTime ' Wait until the start time if the current time is before 10 PM End If sentCount = 0 ' Retrieve drafts from the drafts folder Set draftFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts) Set draftItems = draftFolder.Items ' Count the number of draft emails that contain "Security " For Each draft In draftItems If draft.Class = olMail Then If InStr(1, draft.Body, "Security ", vbTextCompare) > 0 Then draftCount = draftCount + 1 End If End If Next draft ' Loop through the drafts and send them at the designated intervals if they contain "Security " For Each draft In draftItems If draft.Class = olMail Then If draft.Sent = False And InStr(1, draft.Body, "Security ", vbTextCompare) > 0 Then ' Create a new mail item and copy the content from the draft Dim newMail As Outlook.MailItem Set newMail = Application.CreateItem(olMailItem) newMail.BodyFormat = draft.BodyFormat newMail.Body = draft.Body newMail.Subject = draft.Subject ' Send the new mail item newMail.Send sentCount = sentCount + 1 ' Wait for the interval before sending the next email If sentCount < draftCount Then Delay intervalMinutes ' Wait for the specified interval currTime = currTime + TimeSerial(1, 0, 0) ' Add 1 hour to the current time End If End If End If Next draft ExitSub: Exit Sub ErrorHandler: MsgBox "An error occurred: " & Err.Description ' Display the error message Resume ExitSub ' Exit the sub End Sub Sub Delay(ByVal minutes As Long) Dim targetTime As Date targetTime = Now + TimeSerial(0, minutes, 0) Do Until Now >= targetTime DoEvents Loop End Sub