Please help VBA code not working properly send email when due dates

[Tia]

Hello i am looking for a VBA coding that allows to have an email once
one of the employe has an expiry date to be renewed
Example :
Sheet name : expiry dates
D1= Employee Name Row 4
E1= Birthdate row 5
F1= Passport renewal date
J1= Driving license renewal date
H1= Visa card renewal date
And list of columns for expiry dates till row AJ1 Row 36
Ak1 = Supervisor name to send the email to row 37
AL = email adress to send the mail to row 38

I want a text informing me that this employee needs the following* to
be renewed for him

I CHECK THIS SITE BUT I AM A BIGGINER IN VBA i didnt understand it
http://www.rondebruin.nl/mail/change.htm

I have made a search and found the following but it is not working
properly i dont know what i made wrong
Best Regards

The code that i used is as followed pasted in workbook


Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As
String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal
lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Sub SendEMail()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Dim r As Integer, x As Double
For r = 4 To 5 'data in rows 4-5
' Get the email address
Email = Cells(r, 34)

' Message subject
Subj = "Upcoming Expiration Date(s)"

' Compose the message
Msg = ""
'Supervisor Name below
Msg = Msg & "Dear " & Cells(r, 33) & "," & vbCrLf & vbCrLf
Msg = Msg & "The following employee has a due date set to
expire on "
'Expiration Date
Msg = Msg & Cells(r, 4).Text & "." & vbCrLf & vbCrLf
Msg = Msg & "Tia kareem" & vbCrLf
Msg = Msg & "HR Manager"

' Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ",
"%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ",
"%20")

' Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf,
"%0D%0A")
' Create the URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString,
vbNullString, vbNormalFocus

' Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
Next r
End Sub