Why is VBA code slowing down when processing larger tables - mysql

Question

I got problem with one of my subroutines, which job is to convert any passed ListObject (ussually generated by powerquery) into multiple MySQL queries, then send them to database. Queries and progress are shown on userform, that refresh with every query. My problem is that for some reason with some large tables, code starts out very quickly, but at some point it instantly slows down to fraction of speed it started and excel ram usage is increasing by +-1MB/s while running, and after code finish, it stays there.
With smaller tables (low column count, or small values in cells) it can process tens of thousands rows very fast without slowing, but problem comes with some large tables (either higher column count, or big values in cells, for ex. long strings etc...) after like 3k rows.
This sub is responsible for looping thru table, and building insert queries, then every few rows (depending on query length) calls function, that can send any query into selected DB. The problem is in "For i" loop, but i including whole code here.
Public Sub UploadniPayload(DBtabulka As String, Zdroj As ListObject, Optional Databaze As String = "tesu")
If ErrorMode = False Then On Error Resume Next
Dim Prikaz As String, Radek As String, Payload As String, i As Long, x As Long, PocetRadku As Long, PocetSloupcu As Long, DBsloupce As Long
Call VyplnNetInfo(DBIP)
AutoUploader.loading_sql.Value = 0
PocetRadku = Zdroj.DataBodyRange.Rows.Count
PocetSloupcu = Zdroj.DataBodyRange.Columns.Count
DBsloupce = DBPocetSloupcu(DBtabulka, Databaze)
If JeTabulkaPrazdna(Zdroj) = False Then
If (Zdroj.DataBodyRange.Columns.Count + 1) = DBsloupce Then
'PROBLEM APPEARING IN THIS LOOP
For i = 1 To PocetRadku
For x = 1 To PocetSloupcu
If x <= 0 Then Exit For
If x = 1 Then
Payload = "'','" & Zdroj.DataBodyRange(i, x).Text & "'"
Else
Payload = Payload & ",'" & Zdroj.DataBodyRange(i, x).Text & "'"
End If
Next x
Radek = "(" & Payload & ")"
If Prikaz <> vbNullString Then Prikaz = Prikaz & ", " & Radek Else Prikaz = Radek
If i = PocetRadku Or Len(Prikaz) > 2500 Then
AutoUploader.loading_sql.Value = i / PocetRadku
AutoUploader.txtStatus.Caption = "Zpracovávám " & i & "/" & PocetRadku & " řádků"
Prikaz = "INSERT INTO `" & Databaze & "`.`" & DBtabulka & "` VALUES " & Prikaz
Call PrikazSQL(Prikaz, Databaze)
Prikaz = vbNullString
Payload = vbNullString
End If
Next i
Else
Call Zaloguj("System", "Error - počet sloupců v " & Zdroj.Name & " (" & PocetSloupcu & "+1 ID) nesouhlasí s počtem sloupců v " & DBtabulka & "(" & DBsloupce & ")", False)
End If
Else
Call Zaloguj("System", "Error - pokus o upload prázdné tabulky (" & Zdroj.Name & ") do DB (" & DBtabulka & ")", False)
End If
If AutoUploader.chb_Uklizecka.Value = True Then Call VycistiTabulku(Zdroj)
End Sub
And this is my function responsible for sending queries into database.
Sometimes i use it for pulling single value from database, so it acts as string, but when i need only insert, i just using Call. DBIP, DBUser and DBPass are global variables.
Public Function PrikazSQL(ByRef Prikaz As String, Optional Databaze As String = "tesu") As String
On Error GoTo ErrHandler
AutoUploader.IconDirectSQL.BackColor = vbGreen
AutoUploader.txtKUK.Value = Prikaz
'If ErrorMode = True Then Call Zasifruj
DoEvents
Dim Pripojeni As ADODB.Connection, RS As ADODB.Recordset
Set Pripojeni = CreateObject("ADODB.Connection")
Set RS = CreateObject("ADODB.RecordSet")
Pripojeni.Open "" & _
"DRIVER={MySQL ODBC 8.0 UNICODE Driver}" & _
";SERVER=" & DBIP & _
";DATABASE=" & Databaze & _
";USER=" & DBUser & _
";PASSWORD=" & DBPass & _
";Option=3"
With RS
.CursorLocation = adUseClient
.LockType = adLockBatchOptimistic
.Open Prikaz, Pripojeni
.ActiveConnection = Nothing
End With
Pripojeni.Close
Set Pripojeni = Nothing
If RS.Fields.Count > 0 Then PrikazSQL = RS(0)
Set RS = Nothing
AutoUploader.IconDirectSQL.BackColor = vbWhite
DoEvents
Exit Function
ErrHandler:
RS.ActiveConnection = Nothing
If Not Pripojeni Is Nothing Then
Pripojeni.Close
Set Pripojeni = Nothing
End If
If RS.Fields.Count > 0 Then PrikazSQL = RS(0)
Set RS = Nothing
AutoUploader.IconDirectSQL.BackColor = vbWhite
DoEvents
Call Debuger("ERROR:" & vbCrLf & Err.Description & vbCrLf & vbCrLf & "QUERY:" & vbCrLf & Prikaz, "PrikazSQL")
End Function
Code above is only part of the autonomous bot, on start it apply these settings:
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
DoEvents is used only for refreshing userform, instead of repaint.
I try to unload any object or variable, that i dont need, but i think i am missing something important. Any other part of code runs fine. Any help would be very appreciated.