Loop through a Userform ListBox and create an insert query string for SQL

I am writing a user form that has the simple function of moving stock from one BIN to another. My stock transactions are all in a single table. I have created an sql view that gives me stock totals by code and location.

I can then search current location and bring up all the stock in a listbox to view. I then scan the second location.

The macro I am working on is the 'Record' command.

It's objective is to create the following sql string/s based on the listbox results.

INSERT INTO db.tblstocktrans (`IDtblStocktrans`, `DateTime`, `STCode`, `StockLocation`, `MovementType`, `UnitType`, `Units`, `Attachment`, `keyPersonnel`) VALUES ('1751', '2022-01-11 00:00:00', '000238', 'D-01-40', 'MoveOut', 'Unit', '10', ?, '28');
INSERT INTO db.tblstocktrans (`IDtblStocktrans`, `DateTime`, `STCode`, `StockLocation`, `MovementType`, `UnitType`, `Units`, `Attachment`, `keyPersonnel`) VALUES ('1752', '2022-01-11 00:00:00', '001063', 'D-01-40', 'MoveOut', 'Unit', '9', ?, '28');
INSERT INTO db.tblstocktrans (`IDtblStocktrans`, `DateTime`, `STCode`, `StockLocation`, `MovementType`, `UnitType`, `Units`, `Attachment`, `keyPersonnel`) VALUES ('1753', '2022-01-11 00:00:00', '001290', 'D-01-40', 'MoveOut', 'Unit', '8', ?, '28');
INSERT INTO db.tblstocktrans (`IDtblStocktrans`, `DateTime`, `STCode`, `StockLocation`, `MovementType`, `UnitType`, `Units`, `Attachment`, `keyPersonnel`) VALUES ('1754', '2022-01-11 00:00:00', '001111', 'D-01-40', 'MoveOut', 'Unit', '7', ?, '28');

INSERT INTO db.tblstocktrans (`IDtblStocktrans`, `DateTime`, `STCode`, `StockLocation`, `MovementType`, `UnitType`, `Units`, `Attachment`, `keyPersonnel`) VALUES ('1751', '2022-01-11 00:00:00', '000238', 'D-02-40', 'MoveIn', 'Unit', '10', ?, '28');
INSERT INTO db.tblstocktrans (`IDtblStocktrans`, `DateTime`, `STCode`, `StockLocation`, `MovementType`, `UnitType`, `Units`, `Attachment`, `keyPersonnel`) VALUES ('1752', '2022-01-11 00:00:00', '001063', 'D-02-40', 'MoveIn', 'Unit', '9', ?, '28');
INSERT INTO db.tblstocktrans (`IDtblStocktrans`, `DateTime`, `STCode`, `StockLocation`, `MovementType`, `UnitType`, `Units`, `Attachment`, `keyPersonnel`) VALUES ('1753', '2022-01-11 00:00:00', '001290', 'D-02-40', 'MoveIn', 'Unit', '8', ?, '28');
INSERT INTO db.tblstocktrans (`IDtblStocktrans`, `DateTime`, `STCode`, `StockLocation`, `MovementType`, `UnitType`, `Units`, `Attachment`, `keyPersonnel`) VALUES ('1754', '2022-01-11 00:00:00', '001111', 'D-02-40', 'MoveIn', 'Unit', '7', ?, '28');

As each BIN location can have multiple and variable number of product lines I wanted my code to loop through the list and update the database line by line.

This is the best I have come up with but can't get it to work.

Private Sub cmdRecord_Click()

Dim i As Integer
For i = 0 To ListBox1.ListCount - 1

        Dim SUnits As Integer
    Dim STCode1 As String
    Dim UnitType1
    On Error GoTo ErrorHandler
        
    SUnits = ListBox1.List(i, 4).Value
    STCode1 = ListBox1.List(i, 2).Value
                    
    Dim FindRow
    Dim cRow As String
    cRow = STCode1
    Set FindRow = Sheets("tblStock").Range("$A:$A").Find(What:=cRow, LookIn:=xlValues)
    UnitType1 = FindRow.Offset(0, 23)
    
        Dim objConn As Object
        Set objConn = CreateObject("ADODB.Connection")
        
        Dim StrA As String
        Dim Str1 As String
        Dim Str2 As String
        Dim Str3A As String
        Dim Str3B As String
        Dim Str4A As String
        Dim Str4B As String
        Dim Str5 As String
        Dim Str6A As String
        Dim Str6B As String
        Dim Str7 As String
        
        StrA = "INSERT INTO tblstocktrans" & _
        " (DateTime,STCode,StockLocation,MovementType,UnitType,Units,keyPersonnel) Values("
        Str1 = "'" & BINMove.TextBoxDate.Value & "',"
        Str2 = "'" & STCode1 & "',"
        Str3A = "'" & BINMove.FromBIN.Value & "',"
        Str3B = "'" & BINMove.ToBIN.Value & "',"
        Str4A = "'MoveOut',"
        Str4A = "'MoveIn',"
        Str5 = "'" & UnitType1 & "',"
        Str6A = "'" & -(SUnits) & "',"
        Str6B = "'" & SUnits & "',"
        Str7 = "'" & BINMove.ID.Value & "'"
        
        With objConn
        
        .Open "Driver=MySQL ODBC 8.0 Unicode Driver;SERVER=********.mysql.database.azure.com;DATABASE=*****db;user=********;pwd=**********;PORT=3306;DFLT_BIGINT_BIND_STR=1"
        
        .Execute StrA & _
        Str1 & _
        Str2 & _
        Str3A & _
        Str4A & _
        Str5 & _
        Str6A & _
        Str7 & ");"
        
        .Execute StrA & _
        Str1 & _
        Str2 & _
        Str3B & _
        Str4B & _
        Str5 & _
        Str6B & _
        Str7 & ");"
        
        .Close
        
        End With
Next i
    
ActiveWorkbook.Connections("MySQL.db.qryrecentstocktake3").Refresh
 
'Message Box
 
Dim answer As Integer
answer = MsgBox("Stock Updated" & Chr(10) & "Do you want to move another BIN?", vbYesNo)
 
  If answer = vbYes Then
  Call cmdSearch_Click
  Else
    Unload Me
  End If

FromBIN.SetFocus

ErrorHandler:: Exit Sub

End Sub

Thanks in Advance