Last record is not adding to database

Hi Friends,

When I exporting data from excel to a table in the Access Database. It took all records except last record. I hope it may be wrong in loop. Please kindly rectify it. I attached my code below.

Sub ADOFromExcelToAccess()
' exports data from active worksheet to to a table in Access database
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim r As Long

    ' Connect to the access database
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & "Data Source=C:\Employee.mdb"
    
    ' open a record set
    Set rs = New ADODB.Recordset
    rs.Open "Emp", cn, adOpenKeyTest, adLockOptimistic, adCmdTable
    
    ' all records in a table
    
    r = 2 ' the start row in the worksheet
    
    Do While Len(Range("A" & r).Formula) > 0
    
        With rs
            .AddNew
            ' add values to each field in the record.
            .Fields("Empno") = Range("A" & r).Value
            .Fields("Empname") = Range("B" & r).Value
            .Fields("Desig") = Range("C" & r).Value
            .Fields("Address") = Range("D" & r).Value
            .Fields("Contactno") = Range("E" & r).Value
            .Fields("Salary") = Range("F" & r).Value
        End With
        
        r = r + 1 'next row
    Loop
    
    cn.Close
    Set cn = Nothing
    rs.Close
    Set rs = Nothing
 End Sub