Write Multiple Rows in EXCEL (VB) to SQL Table - sql-server

Question

Would like to be able to write all rows that have data in them to SQL table, with the below I can only export the 1st row. If I add more rows of data and click the Export Button I will only send the first row. Can some one help me script my request?
Sub Button1_Click()
Dim conn As ADODB.Connection
Dim cmd As ADODB.Command
Dim strSQL As String
strSQL = "INSERT INTO dbo.TimeLog" & _
"(EventDate, ID, DeptCode, Opcode, StartTime, FinishTime, Units) " & _
"VALUES (?,?,?,?,?,?,?);"
Set conn = New ADODB.Connection
conn.Open "Provider=SQLOLEDB;Data Source=db\db1;Initial Catalog=Table1;Integrated Security=SSPI;"
'Skip the header row
iRowNo = 2
Set cmd = New ADODB.Command
cmd.ActiveConnection = conn
cmd.CommandType = adCmdText
cmd.CommandText = strSQL
iRowNo = 2
With Sheets("Sheet1")
'Loop until empty cell in EventDate
Do Until .Cells(iRowNo, 1) = ""
cmd.Parameters.Append _
cmd.CreateParameter("pEventDate", adVarChar, adParamInput, 8, .Cells(iRowNo, 1))
cmd.Parameters.Append _
cmd.CreateParameter("pID", adInteger, adParamInput, , .Cells(iRowNo, 2))
cmd.Parameters.Append _
cmd.CreateParameter("pDeptCode", adVarChar, adParamInput, 2, .Cells(iRowNo, 3))
cmd.Parameters.Append _
cmd.CreateParameter("pOpCode", adVarChar, adParamInput, 2, .Cells(iRowNo, 4))
cmd.Parameters.Append _
cmd.CreateParameter("pStartTime", adDBTime, adParamInput, 0, .Cells(iRowNo, 5))
cmd.Parameters.Append _
cmd.CreateParameter("pFinishTime", adDBTime, adParamInput, 0, .Cells(iRowNo, 6))
cmd.Parameters.Append _
cmd.CreateParameter("pUnits", adInteger, adParamInput, , .Cells(iRowNo, 7))
cmd.Execute
iRowNo = iRowNo + 20
Loop
MsgBox "Success!"
End With
conn.Close
Set conn = Nothing
End Sub