Hourly Auto Email with Scheduler

In this article, we have created an automation to send everyday auto multiple emails using scheduler in Excel VBA. This Hourly Auto Email with Scheduler automation required Microsoft Outlook to send the multiple email using Excel VBA.

We have used Application.Ontime to schedule the Email using VBA. Please read more about Application.Ontime from below link:

https://docs.microsoft.com/en-us/office/vba/api/Excel.Application.OnTime

Hourly Auto Email with Scheduler

Click to buy Hourly Auto Email with Scheduler

Below is the VBA codes which have used to create this automation-

Sub Send_Email()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Auto Email")

'''''''''' Update Next ''''''''''''''

Call Update_Next_Schedule_Time
Application.OnTime sh.Range("N24").Value, "Send_Email"

''''''''''''''''''''''''''''''''''''''

Dim oa As Object
Dim msg As Object

Set oa = CreateObject("outlook.application")
Set msg = oa.createitem(0)

With msg
.To = sh.Range("E6").Value
.CC = sh.Range("E8").Value
.Subject = sh.Range("E10").Value
.Body = sh.Range("E12").Value
.attachments.Add "C:\Users\info\Desktop\Sample File.txt"
.send
End With

End Sub

Sub Update_Next_Schedule_Time()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Auto Email")
sh.Unprotect
sh.Range("N24").Value = ""

Dim i As Integer

Dim dt As Date

If Time > Application.WorksheetFunction.Max(sh.Range("N6:N20")) Then
dt = Date + 1
Else
dt = Date
End If

If UCase(Format(dt, "DDD")) = "SAT" Then
If sh.Range("O22").Value = True And sh.Range("O23").Value = False Then
dt = dt + 1
ElseIf sh.Range("O22").Value = True And sh.Range("O23").Value = True Then
dt = dt + 2
End If
ElseIf UCase(Format(Date, "DDD")) = "SUN" Then
If sh.Range("O23").Value = True Then
dt = dt + 1
End If
End If


If dt > Date Then
sh.Range("N24").Value = dt + Application.WorksheetFunction.Min(sh.Range("N6:N20"))
Else

For i = 6 To 20
If Time < sh.Range("N" & i).Value Then
sh.Range("N24").Value = sh.Range("N" & i).Value + dt
Exit For
End If
Next i
End If

sh.Protect

End Sub

Sub Set_Schedule()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Auto Email")
Call Update_Next_Schedule_Time

Application.OnTime sh.Range("N24").Value, "Send_Email"

MsgBox "Schedule Set"

End Sub

Sub Cancel_Schedule()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Auto Email")

On Error Resume Next
Application.OnTime sh.Range("N24").Value, "Send_Email", , False

MsgBox "Schedule Cancelled"

End Sub

See our other Email automation templates:

• Send WhatsApp and Email without VBA
• Bulk Auto Emailer with Picture Signature and HTML body
• Send bulk emails using VBA and Outlook
• Email Data Consolidation Tool in Excel
• Automated Bulk Emails Form in Excel VBA
• VBA: Send Email With Outlook Mail body Snapshot

Visit our YouTube channel to learn step-by-step video tutorials

Youtube.com/@PKAnExcelExpert

Click to buy Hourly Auto Email with Scheduler

Watch the step by step video tutorial:

Click to buy Hourly Auto Email with Scheduler