Object vereist melding bij ADODB.Connection

Status
Niet open voor verdere reacties.
M

Muiter

Gebruiker
Lid geworden
11 jul 2008
Berichten
73
Wat doe ik fout in onderstaande code? Ik krijg de melding 'Object vereist' in het 2e deel

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=xxxxxr;" & _
        "DATABASE=xxxx;" & _
        "USER=xxxx;" & _
        "PASSWORD=xxxx;" & _
        "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("Voorblad")
    Set rs = New ADODB.Recordset
    
    With shtVoorblad
        Dim strsql_basis As String
            strsql_basis = "INSERT INTO is_calculatie (offerte_id,soort) VALUES ('" & Sheets("Voorblad").Range("J12").Value & "','kg')"

            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("Voorblad")
    Set rs = New ADODB.Recordset
    
    With shtVoorblad
        Dim row_pr As Integer
        Dim strsql_pr As String
        row_pr = 2
        While Trim(.Cells(row_pr, 2)) <> ""
            strsql_pr = "INSERT INTO is_calculatie_producten (id_calculatie, lengte, breedte, dikte, aantal, materiaal) " & _
            "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)) & "')"

            oConn.Execute strsql_pr, , adExecuteNoRecords Or adCmdText
            row_pr = row_pr + 1
        Wend
    End With
    
    MsgBox "Er zijn " & 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
 
Hoe moet de macro 'Private Sub cmdInsertData_Click()' weten waar oconn voor staat ?
 
snb zei:
Hoe moet de macro 'Private Sub cmdInsertData_Click()' weten waar oconn voor staat ?
Klik om te vergroten...

Hoezo? De eerste query in de code werkt namelijk wel

Onderstaande de originele code die ik ben gaan aanpassen:
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=xxxxxx;" & _
        "DATABASE=xxxxx;" & _
        "USER=xxxxx;" & _
        "PASSWORD=xxxx;" & _
        "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("controleblad")
    Set rs = New ADODB.Recordset
    
    With shtControleblad
        Dim strsql_basis As String
            strsql_basis = "INSERT INTO is_calculatie (offerte_id) VALUES ('" & Sheets("controleblad").Range("D1").Value & "')"

            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("materialen")
    Set rs = New ADODB.Recordset
    
    With shtMaterialen
        Dim row_pl As Integer
        Dim strsql_pl As String
        row_pl = 2
        While Trim(.Cells(row_pl, 2)) <> ""
            strsql_pl = "INSERT INTO is_calculatie_platen (id_calculatie, cnc, lengte_genest, lengte_nodig, breedte_genest, breedte_nodig, dikte, materiaal, aantal, snijtijd, machine) " & _
            "VALUES ('" & strsql_last_id & "','" & _
            esc(Trim(.Cells(row_pl, 1).Value)) & "', '" & _
            esc(Trim(.Cells(row_pl, 2).Value)) & "', '" & _
            esc(Trim(.Cells(row_pl, 3).Value)) & "', '" & _
            esc(Trim(.Cells(row_pl, 4).Value)) & "', '" & _
            esc(Trim(.Cells(row_pl, 5).Value)) & "', '" & _
            esc(Trim(.Cells(row_pl, 6).Value)) & "', '" & _
            esc(Trim(.Cells(row_pl, 7).Value)) & "', '" & _
            esc(Trim(.Cells(row_pl, 8).Value)) & "', '" & _
            esc(Trim(.Cells(row_pl, 9).Value)) & "', '" & _
            esc(Trim(.Cells(row_pl, 10).Value)) & "')"

            oConn.Execute strsql_pl, , adExecuteNoRecords Or adCmdText
            row_pl = row_pl + 1
        Wend
    End With
    
    Set wsCtcts = Worksheets("producten")
    Set rs = New ADODB.Recordset
    
    With shtProducten
        Dim row_pr As Integer
        Dim strsql_pr As String
        row_pr = 2
        While Trim(.Cells(row_pr, 2)) <> ""
            strsql_pr = "INSERT INTO is_calculatie_producten (id_calculatie, pos, lengte, breedte, dikte, aantal, materiaal, snijtijd, machine, gew_bruto, gew_netto, starts) " & _
            "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, 6).Value)) & "', '" & _
            esc(Trim(.Cells(row_pr, 7).Value)) & "', '" & _
            esc(Trim(.Cells(row_pr, 8).Value)) & "', '" & _
            esc(Trim(.Cells(row_pr, 9).Value)) & "', '" & _
            esc(Trim(.Cells(row_pr, 10).Value)) & "', '" & _
            esc(Trim(.Cells(row_pr, 11).Value)) & "')"

            oConn.Execute strsql_pr, , adExecuteNoRecords Or adCmdText
            row_pr = row_pr + 1
        Wend
    End With
    
    MsgBox "Er zijn " & Trim(Str(row_pl - 2)) & " 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

Echter als ik hem dus ga aanpassen tot de code in mijn TS wekt hij niet meer.
 
Laatst bewerkt:
Op welke regel krijg je de foutmelding? Want in de structuur zie ik ook op voorhand niet zo snel een fout.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan