Insert multiple records using ADO?

Sub PushDataToMDB()
  Dim cnn As ADODB.Connection
  Dim rst As ADODB.Recordset
  Dim sSQL As String
  Dim sPath As String
  Dim rSource As Range
  Dim MyConn
  Dim Rw As Long, LastRow As Long
  
  Set rSource = Range("DataLoader")
  LastRow = rSource.Rows.Count
  
  sPath = Range("TPath").Value
  
  MyConn = sPath
  
  Set cnn = New ADODB.Connection
  With cnn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .Open MyConn
  End With
  
  Set rst = New ADODB.Recordset
  rst.CursorLocation = adUseServer
  rst.Open Source:="tblProjectData", ActiveConnection:=cnn, _
    CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
      Options:=adCmdTable
      
  Application.ScreenUpdating = False
  Application.Goto Range("DataLoader")
  
  For Rw = 2 To LastRow
    ActiveCell.Offset(1, 0).Select
    rst.AddNew
    Application.StatusBar = "Adding Record " & Rw & " of " & LastRow
    
    rst("Project") = Cells(ActiveCell.Row, 1)
    'continue looping thru fields till the last one...
    rst("Version") = Cells(ActiveCell.Row, 34)
    
    rst.Update
  Next Rw
  Application.StatusBar = ""
  rst.Close
  cnn.Close
  
  Application.ScreenUpdating = True


End Sub

Dim cnt As ADODB.Connection
Dim stSQL As String, stCon As String, stDB As String

'Path to and the name of the database
stDB = ThisWorkbook.Path & "\Db1.mdb"

'The connection string.
stCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & stDB & ";"

'Create the Export-query.
stSQL = "INSERT INTO Table1 SELECT * FROM [DataLoader] IN '" _
        & ThisWorkbook.FullName & "' 'Excel 8.0;'"

'Instantiate the ADODB COM Object.
Set cnt = New ADODB.Connection

With cnt
    .Open stCon
    'Execute the update.
    .Execute (stSQL)
End With

'Close the connection.
cnt.Close

'Release object from memory.
Set cnt = Nothing