Ik heb een VBA script gekopieerd uit een oude Excel file die ik ooit heb gemaakt. Echter nu krijg ik de melding 'Object vereist' in de laatste ErrHandler.
Code:
Dim oConn As ADODB.Connection
Dim rs As ADODB.Recordset
Function esc(txt As String)
esc = Trim(Replace(txt, ",", "."))
End Function
Private Sub ConnectDB(testmode As Boolean)
On Error GoTo ErrHandler
Set oConn = New ADODB.Connection
oConn.Open "DRIVER={MySQL ODBC 5.1 Driver};" & _
"SERVER=localhost;" & _
"DATABASE=database_asc;" & _
"USER=database;" & _
"PASSWORD=prodegro;" & _
"Option=3"
Exit Sub
ErrHandler:
MsgBox Err.Description, vbCritical, Err.Source
End Sub
Private Sub cmdInsertData_Click()
ConnectDB False
On Error GoTo ErrHandler
Dim wsCtcts As Worksheet
Set wsCtcts = Worksheets("Oversturen")
Set rs = New ADODB.Recordset
With shtOversturen
Dim strsql_basis As String
strsql_basis = "INSERT INTO calculatie_id (dossier_id,type) VALUES ('" & Sheets("Oversturen").Range("B2").Value & "','excel')"
oConn.Execute strsql_basis, , adExecuteNoRecords Or adCmdText
Dim strsql_last_id As String
strsql_last_id = "select last_insert_id()"
rs.Open strsql_last_id, oConn, adOpenForwardOnly, adLockReadOnly, adCmdText
If Not rs.EOF Then
strsql_last_id = rs.Fields(0).Value
End If
End With
Set wsCtcts = Worksheets("Oversturen")
Set rs = New ADODB.Recordset
With shtOversturen
Dim row_pr As Integer
Dim strsql_pr As String
row_pr = 2
While Trim(.Cells(row_pr, 5)) <> ""
strsql_pr = "INSERT INTO calculatie_inh (id_calculatie, pos, aantal, lengte, breedte, dikte, kwaliteit_id, gewicht, prijs, opmerking) " & _
"VALUES ('" & strsql_last_id & "','" & _
esc(Trim(.Cells(row_pr, 1).Value)) & "', '" & _
esc(Trim(.Cells(row_pr, 2).Value)) & "', '" & _
esc(Trim(.Cells(row_pr, 3).Value)) & "', '" & _
esc(Trim(.Cells(row_pr, 4).Value)) & "', '" & _
esc(Trim(.Cells(row_pr, 5).Value)) & "', '" & _
esc(Trim(.Cells(row_pr, 12).Value)) & "', '" & _
esc(Trim(.Cells(row_pr, 7).Value)) & "', '" & _
esc(Trim(.Cells(row_pr, 8).Value)) & "', '" & _
esc(Trim(.Cells(row_pr, 9).Value)) & "')"
oConn.Execute strsql_pr, , adExecuteNoRecords Or adCmdText
row_pr = row_pr + 4
Wend
End With
MsgBox "Er zijn " & Trim(Str(row_pl - 5)) & " platen en " & Trim(Str(row_pr - 2)) & " producten geïmporteerd", vbInformation, "Gereed!"
ErrHandler:
If Err.Description <> "" And Err.Source <> "" Then
MsgBox Err.Description, vbCritical, Err.Source
End If
End Sub
Private Sub CommandButton1_Click()
End Sub