Enviar Emails quando estiver na Data Actual (VBA)

Pretende-se com este código que quando a Data de Envio for igual a data em que nos encontramos é enviado um email ao destinatário.

O código pesquisa todos os registos e envia para cada email onde a condição da data for a data actual.

VBA Code/Macro:

Sub SendEmail()

Dim ws As Worksheet
Dim oApp As Object, MailApp As Object, SendMail As Object
Dim strbody As String
Dim deldate As Variant
Dim email As Variant
Dim i As Integer

Set ws = Worksheets("sheet1")
ws.Select

'Set numrows = number of rows of data.
NumRows = Range("A2", Range("A2").End(xlDown)).Rows.Count

' Select cell A2
Range("A2").Select

'Get Delivery date
lin = 2
col = 4
deldate = ws.Cells(lin, col).Value

'Get email
lin = 2
col = 7
email = ws.Cells(lin, col).Value
' -1 because sheet have header
For i = 1 To NumRows - 1

If deldate = Date Then

'Create Email
Set MailApp = CreateObject("Outlook.Application")
Set SendMail = MailApp.CreateItem(0)
'Conteudo corpo da mensagem
strbody = "Your require thing has been delivered ... " & vbNewLine & vbNewLine & _
"Thanks" & vbNewLine & _
"..."

On Error Resume Next
With SendMail
.To = email '<- Email to send
.CC = ""
.BCC = ""
.Subject = "Your require thing has been delivered ..."
.Body = strbody '<- Body message
.Send ' .Display <- Before send email to client show
' .send <- Send Email direct
End With
Else: Exit Sub
End If
ActiveCell.Offset(lin + i, 0).Select
deldate = ws.Cells(lin + i, 4).Value
email = ws.Cells(lin + i, 7).Value
Next

End Sub