Sending Outlook emails from Excel; Limits to three emails only?

Hi,

I'm trying a use excel send send a long list of customised emails, however I'm running into a problem in that it will only email three adresses from the list and ignore everything else. Here's the code I'm currently using:

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 = 2 To 4 'data in rows 2-4

        Email = Cells(r, 1)
        
        Subj = "Test Email"

'         Msg = ""
        Msg = Msg & "Dear " & Cells(r, 2) & "," & vbCrLf & vbCrLf
        Msg = Msg & "I am pleased to inform you . . ." & vbNewLine & " Test Greeting "

        Msg = Msg & Cells(r, 3).Text & "." & vbCrLf & vbCrLf
        Msg = Msg & "Best Regards" & vbCrLf
        Msg = Msg & " Test " & vbCrLf
        Msg = Msg & "test"
        
        Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
        Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")
                
        Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")

        URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

        ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

        Application.Wait (Now + TimeValue("0:00:01"))
        Application.SendKeys "%s"
    Next r
End Sub

Can anyone see any problems with the code above?

Any advice will be much appreciated.