PDA

View Full Version : Loop doesn't work when insert multiple rows from excel to mysql



A_Di
02-15-2017, 11:14 PM
Dear Experts,

I have tried to insert multiple rows from excel to mysql, but only get one data that insert to mysql. Below is the code. Any thoughts? Kindly help. Thanks!



Sub SqlConnection()
Dim sqlstringinsert As String
Dim connstring As String
Dim sLogon As String
'Sets the database connection
sLogon = "Uid=root;Pwd=;"
connstring = "ODBC;DSN=
​my_dsn;" & sLogon


'Skip the header row
rowctr = 5




Do Until esc(Trim(Cells(rowctr, 12).Value)) = ""
'Generate and execute sql statement to import the excel rows to SQL Server table
sqlstringinsert = "INSERT INTO
​ table (​one​,​two​​,​three​,​four​,​five​,​six​,​seven​,​eight​) VALUES ('" & esc(Trim(Cells(rowctr, 12).Value)) & "','" & esc(Trim(Cells(2, 44).Value)) & "','" & esc(Trim(Cells(1, 26).Value)) & "','" & esc(Trim(Cells(3, 26).Value)) & "','" & esc(Trim(Cells(rowctr, 45).Value)) & "','" & esc(Trim(Cells(rowctr, 46).Value)) & "','" & esc(Trim(Cells(rowctr, 47).Value)) & "','" & esc(Trim(Cells(rowctr, 54).Value)) & "')"
rowctr = rowctr + 1
Loop


Dim thisQT As QueryTable
Set thisQT = ActiveSheet.QueryTables.Add(Connection:=connstring, Destination:=Range("A1"), sql:=sqlstringinsert)
thisQT.BackgroundQuery = False




thisQT.sql = sqlstringinsert




On Error GoTo XERR
thisQT.Refresh


Exit Sub


XERR:
If Err.Number = 1004 Then
Resume Next
ElseIf Err.Number <> 0 Then
MsgBox Err.Number & vbCr & Err.Source & vbCr & vbCr & Err.Description, vbCritical
Err.Clear
End If


End Sub