• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Object vereist

Status
Niet open voor verdere reacties.

Muiter

Gebruiker
Lid geworden
11 jul 2008
Berichten
73
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
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan