Make excel VBA write to SQL faster

I have an adapted VBA script that writes to an SQL database (writes ~1500 rows).

The script works, it takes 5min to run (too long) and causes excel vba to show up as not responding.

Any methods to improve the speed of the write to SQL would be helpful.

How would one change this script to write to SQL faster?

Public Sub ConnectToDB()
    Dim DBCONT As Object
    Dim strConn As String
    Dim Database_Name As String
    Dim Table_Name As String
    Dim strSQL As String
    Dim rs As Object
    Dim LastRow As Long
    Dim i As Long
    Dim sCountry, sAsset_type, sYear, sQuarter, sinput_remaining_budget_pct_of_post_ufl_production As String

'   SET ALL VARIABLES
    Database_Name = "<DATABASE_NAME>" ' Enter your database name here
    Table_Name = "<TABLE_NAME>"

    WkbName = ThisWorkbook.Name
    SheetName = "mine_ufl_input" '  WHERE RS IS

'   SET SQL STRING

    ' PREPARED STATEMENT
    strSQL = "INSERT INTO [ufl]." & Table_Name & _
             "    ([Country], [Asset_type], [Year], [Quarter],[updated_budget_abs])" & _
             " VALUES (?, ?, ?, ?, ?)"
             
    '   SET TO CONNECTION VARIABLES
    Set DBCONT = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    
    DBCONT.ConnectionString = "Provider=sqloledb;Server=<SERVER_NAME>;Database=<DATABASE_NAME>;Trusted_connection=yes;"
    DBCONT.Open
    DBCONT.Execute "truncate table <TABLE_NAME>"
    
    Set sh = ActiveSheet
    
    LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).row
    Debug.Print LastRow
    
    For i = 2 To LastRow
        Set cmd = CreateObject("ADODB.Command")
    
        With cmd
          .ActiveConnection = DBCONT   ' CONNECTION OBJECT
          .CommandText = strSQL        ' SQL STRING
          .CommandType = adCmdText
    
          ' BINDING PARAMETERS
          .Parameters.Append .CreateParameter("sCountryParam", adVarChar, adParamInput, 255, sh.Cells(i, 1))
          .Parameters.Append .CreateParameter("sAsset_typeParam", adVarChar, adParamInput, 255, sh.Cells(i, 2))
          .Parameters.Append .CreateParameter("sYearParam", adVarChar, adParamInput, 255, sh.Cells(i, 3))
          .Parameters.Append .CreateParameter("sQuarterParam", adVarChar, adParamInput, 255, sh.Cells(i, 4))
          .Parameters.Append .CreateParameter("supdated_budget_absParam", adVarChar, adParamInput, 255, sh.Cells(i, 17))
           '... rest of parameters
    
          .Execute                     ' RUN ACTION
        End With
        
        Set cmd = Nothing
    Next i

    Call CloseDB

    MsgBox i & " Lines Imported."

End Sub

Takes <1 second on my local server.

Option Explicit

Public Sub ConnectToDB()

    Dim dbName As String, tableName As String
    Dim sConn As String, dbConn As ADODB.Connection, cmd As ADODB.Command
    Dim ws As Worksheet, lastrow As Long, r As Long
    Dim t0 As Single, p As Long, SQL As String
   
    '   SET ALL VARIABLES
    dbName = "<DATABASE_NAME>" ' Enter your database name here
    tableName = "<TABLENAME>"

    '   SET SQL STRING
    SQL = "INSERT INTO [ufl]." & tableName & _
          " (Country, Asset_type, Year, Quarter,updated_budget_abs)" & _
          " VALUES (?, ?, ?, ?, ?)"
             
    '   SET TO CONNECTION VARIABLES
    sConn = "Provider=sqloledb;Server=<SERVER_NAME>;" & _
            "Database=" & dbName & ";Trusted_connection=yes;"
    
    Set dbConn = New ADODB.Connection
    With dbConn
       .ConnectionString = sConn
       .Open
       .Execute "TRUNCATE TABLE " & tableName
    End With

    ' PREPARED STATEMENT
    Set cmd = New ADODB.Command
    With cmd
        .ActiveConnection = dbConn
        .CommandText = SQL
        .CommandType = adCmdText
        .Prepared = True        
        ' BINDING PARAMETERS
        For p = 0 To 4
            .Parameters.Append .CreateParameter("P" & p, adVarChar, adParamInput, 255)
        Next
    End With

    Dim arFields: arFields = Array(1, 2, 3, 4, 17) ' columns
    t0 = Timer
    
    ' INSERT RECORDS
    Set ws = ActiveSheet ' or Thisworkbook.sheets(""mine_ufl_input")
    With ws
        lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        dbConn.Execute "BEGIN TRANSACTION"
        For r = 2 To lastrow
            For p = 0 To 4
                cmd.Parameters(p).Value = .Cells(r, arFields(p))
            Next
            cmd.Execute ' RUN ACTION
        Next
        dbConn.Execute "COMMIT TRANSACTION"
    End With

    'Call CloseDB
    MsgBox lastrow - 1 & " Lines Imported.", _
           vbInformation, Format(Timer - t0, "0.0 secs")

End Sub


</details>