Public Function ADO_InsertSQL(cColumns As String, cIndex As String, cLocTable As String, cExtTable As String) As Boolean
On Error GoTo Eroare
Dim Rc As DAO.Recordset
Dim I As Integer
Dim vRow As String
Dim eSql As String
Dim vSql As String
Dim vValues As String
Dim MaxAllowedPacket As Long
Dim lRecordsAffected As Long
'Initial Values
ADO_InsertSQL = False
vRow = " ("
vValues = ""
eSql = "INSERT INTO " & cExtTable & " ( " & cColumns & " ) VALUES "
vSql = "SELECT " & cColumns & " FROM " & cLocTable & " ORDER BY [" & cIndex & "]"
'function to check if the connection to the server is active and if not, build it again
SQL_SVN_OC
'flush the table prior to adding data
SQL_SVN.Execute "FLUSH TABLE `" & cExtTable & "`", False
'get the MAX_ALLOWED_PACKET value from MariaDB server
MaxAllowedPacket = SQL_SVN.Execute("SHOW VARIABLES LIKE 'MAX_ALLOWED_PACKET'").Fields(1)
Set Rc = CurrentDb.OpenRecordset(vSql)
If Not POP(Rc) Then 'if the local table has no data, exit with message
MsgBox "Tabelul selectat nu contine date!", vbOKOnly + vbCritical, Application.Name
GoTo IESIRE
End If
Do While Not Rc.EOF
'buid the string containing the data
For I = 0 To Rc.Fields.Count - 1
Select Case Rc.Fields(I).Type
Case 1 'boolean
vRow = vRow & Nz(Val(Rc.Fields(I).Value), "NULL") & ","
Case 3, 4, 7 'integer, double
vRow = vRow & Nz(Rc.Fields(I).Value, "NULL") & ","
Case 8 'date
vRow = vRow & IIf(Nz(Rc.Fields(I).Value, "") = "", "NULL,", "'" & Format(Rc.Fields(I).Value, "yyyy-mm-dd") & "',")
Case 10, 12 'string, memo
vRow = vRow & "'" & Replace(Nz(Rc.Fields(I).Value, ""), Chr(39), "") & "',"
Case Else 'case a different type i haven't coded yet. to lazy to check for everything
Debug.Print Rc.Fields(I).Name
Stop
End Select
Next
'check if the size in bytes is greater than server's max_allowed_packet variable
If LenB(vValues & vRow) <= MaxAllowedPacket Then
'if not, continue to add text to the main string variable
vValues = vValues & Mid(vRow, 1, Len(vRow) - 1) & ")"
vRow = ",("
Else
'if so, write to the server the current string, then start building a new one with the rest of the values
SQL_SVN.Execute eSql & vValues, lRecordsAffected
MsgBox "Au fost inserate " & lRecordsAffected & " inregistrari in [" & cExtTable & "]!", vbOKOnly + vbInformation
vValues = Mid(vRow, 2, Len(vRow) - 2) & ")"
vRow = ",("
End If
Rc.MoveNext
Loop
'if there are leftovers, write the to the server as well
If LenB(vValues) <> 0 Then
SQL_SVN.Execute eSql & vValues, lRecordsAffected
MsgBox "Au fost inserate " & lRecordsAffected & " inregistrari in [" & cExtTable & "]!", vbOKOnly + vbInformation
End If
'everything went OK so update the function's value
ADO_InsertSQL = True
'cleanup
IESIRE:
Set Rc = Nothing
Exit Function
Eroare:
Debug.Print Err.Description
ADO_InsertSQL = False 'on error the function returns false
Resume IESIRE
End Function