sql-serverexcelvbaadodb

Connect an Excel file to an external database to insert a row into that database

I'm trying to connect an Excel file to an external database to insert a row into that database.

I get

Compilation Error - [Microsoft][ODBC Driver 17 for SQL Server] Invalid use of default parameter

I created a test table inside that database and it worked so the table must be the issue.

Const strConn = "DRIVER={ODBC Driver 17 for SQL Server}; SERVER=Remote-SRV\Instance; DATABASE=localdb; UID=sa; PWD=server;"  

/*this is not the actual server data, i wrote the connection line since i believe the driver could be causing this issue maybe*/


Sub InsertAllData()
    Dim sampleDatasheet As Worksheet
    Dim sampleDataRecords As Range
    Dim lastRow As Long
    Dim CODIGO As Integer, FECHA As Date, FECHOR As Date, CODSUR As Integer, MATRICULA As String, TIPO As String, CANT As Integer, PRECIO As Integer, PREMED As Single, TOTAL As Integer, PREVEN As Integer, MARGEN As Integer, TOTVEN As Integer, FACTURADO As String, CODTRA As Integer, SERFAC As String, ANNOFAC As Integer, NUMFAC As Integer, CODVIA As Integer, REFERENCIA As String, APUHAC As Integer, CODPRY As String, KM As Integer, COMPLETO As Integer, LIQUIDADO As Integer, CODLIQ As Integer, IEP As Integer, CODIEP As Integer, FECIEP As Date, IMPIEP As Integer, MEMO As String, TIPPRE As String, VALE As String, LITVALE As Integer, CONCEPTO As String, NUMEXP As String, DTOLIT As Integer, HORAS As Integer, CONHAC As String
    Set sampleDatasheet = ThisWorkbook.Sheets("Muestra")
    lastRow = sampleDatasheet.Range("A1").CurrentRegion.Rows.Count
    For i = 2 To lastRow
        CODIGO = sampleDatasheet.Cells(i, 1)
        FECHA = sampleDatasheet.Cells(i, 2)
        FECHOR = sampleDatasheet.Cells(i, 3)
        CODSUR = sampleDatasheet.Cells(i, 4)
        MATRICULA = sampleDatasheet.Cells(i, 5)
        TIPO = sampleDatasheet.Cells(i, 6)
        CANT = sampleDatasheet.Cells(i, 7)
        PRECIO = sampleDatasheet.Cells(i, 8)
        PREMED = sampleDatasheet.Cells(i, 9)
        TOTAL = sampleDatasheet.Cells(i, 10)
        PREVEN = sampleDatasheet.Cells(i, 11)
        MARGEN = sampleDatasheet.Cells(i, 12)
        TOTVEN = sampleDatasheet.Cells(i, 13)
        FACTURADO = sampleDatasheet.Cells(i, 14)
        CODTRA = sampleDatasheet.Cells(i, 15)
        SERFAC = sampleDatasheet.Cells(i, 16)
        ANNOFAC = sampleDatasheet.Cells(i, 17)
        NUMFAC = sampleDatasheet.Cells(i, 18)
        CODVIA = sampleDatasheet.Cells(i, 19)
        REFERENCIA = sampleDatasheet.Cells(i, 20)
        APUHAC = sampleDatasheet.Cells(i, 21)
        CODPRY = sampleDatasheet.Cells(i, 22)
        KM = sampleDatasheet.Cells(i, 23)
        COMPLETO = sampleDatasheet.Cells(i, 24)
        LIQUIDADO = sampleDatasheet.Cells(i, 25)
        CODLIQ = sampleDatasheet.Cells(i, 26)
        IEP = sampleDatasheet.Cells(i, 27)
        CODIEP = sampleDatasheet.Cells(i, 28)
        FECIEP = sampleDatasheet.Cells(i, 29)
        IMPIEP = sampleDatasheet.Cells(i, 30)
        MEMO = sampleDatasheet.Cells(i, 31)
        TIPPRE = sampleDatasheet.Cells(i, 32)
        VALE = sampleDatasheet.Cells(i, 33)
        LITVALE = sampleDatasheet.Cells(i, 34)
        CONCEPTO = sampleDatasheet.Cells(i, 35)
        NUMEXP = sampleDatasheet.Cells(i, 36)
        DTOLIT = sampleDatasheet.Cells(i, 37)
        HORAS = sampleDatasheet.Cells(i, 38)
        CONHAC = sampleDatasheet.Cells(i, 39)
        Call InsertRecord(CODIGO, FECHA, FECHOR, CODSUR, MATRICULA, TIPO, CANT, PRECIO, PREMED, TOTAL, PREVEN, MARGEN, TOTVEN, FACTURADO, CODTRA, SERFAC, ANNOFAC, NUMFAC, CODVIA, REFERENCIA, APUHAC, CODPRY, KM, COMPLETO, LIQUIDADO, CODLIQ, IEP, CODIEP, FECIEP, IMPIEP, MEMO, TIPPRE, VALE, LITVALE, CONCEPTO, NUMEXP, DTOLIT, HORAS, CONHAC)
    Next
    'MsgBox "| codigo: " & CODIGO & " | fecha: " & FECHA & " | fechor: " & FECHOR & " | codsur: " & CODSUR & " | matricula: " & MATRICULA & " | tipo: " & TIPO & " | cant: " & CANT & " | precio: " & PRECIO & " | premed: " & PREMED & " | total: " & TOTAL & " | preven: " & PREVEN & " | margen: " & MARGEN & " | totven: " & TOTVEN & " | facturado: " & FACTURADO & " | codtra: " & CODTRA & " | serfac: " & SERFAC & " | annofac: " & ANNOFAC & " | numfac: " & NUMFAC & " | codvia: " & CODVIA & " | referencia: " & REFERENCIA & " | apuhac: " & APUHAC & " | codpry: " & CODPRY & " | km: " & KM & " | gompleto: " & COMPLETO & " | liquidado: " & LIQUIDADO & " | codliq: " & CODLIQ & " | iep: " & IEP & " | codiep: " & CODIEP & " | feciep: " & FECIEP & " | impiep: " & IMPIEP & " | memo: " & MEMO & " | tippre: " & TIPPRE & " | vale: " & VALE & " | litvale: " & LITVALE & " | concepto: " & CONCEPTO & " | numexp: " & NUMEXP & " | dtolit: " & DTOLIT & " | horas: " & HORAS & " | conhac: " & CONHAC & " | "'
    'MsgBox "Registros guardados correctamente", vbInformation'
End Sub


Sub InsertRecord(CODIGO As Integer, FECHA As Date, FECHOR As Date, CODSUR As Integer, MATRICULA As String, TIPO As String, CANT As Integer, PRECIO As Integer, PREMED As Single, TOTAL As Integer, PREVEN As Integer, MARGEN As Integer, TOTVEN As Integer, FACTURADO As String, CODTRA As Integer, SERFAC As String, ANNOFAC As Integer, NUMFAC As Integer, CODVIA As Integer, REFERENCIA As String, APUHAC As Integer, CODPRY As String, KM As Integer, COMPLETO As Integer, LIQUIDADO As Integer, CODLIQ As Integer, IEP As Integer, CODIEP As Integer, FECIEP As Date, IMPIEP As Integer, MEMO As String, TIPPRE As String, VALE As String, LITVALE As Integer, CONCEPTO As String, NUMEXP As String, DTOLIT As Integer, HORAS As Integer, CONHAC As String)
    On Error GoTo Catch
    Dim connection As New ADODB.connection
    Dim strSQL As String
    Dim command As New ADODB.command
    connection.Open (strConn)
    strSQL = "INSERT INTO CONSUR (CODIGO, FECHA, FECHOR, CODSUR, MATRICULA, TIPO, CANT, PRECIO, PREMED, TOTAL, PREVEN, MARGEN, TOTVEN, FACTURADO, CODTRA, SERFAC, ANNOFAC, NUMFAC, CODVIA, REFERENCIA, APUHAC, CODPRY, KM, COMPLETO, LIQUIDADO, CODLIQ, IEP, CODIEP, FECIEP, IMPIEP, MEMO, TIPPRE, VALE, LITVALE, CONCEPTO, NUMEXP, DTOLIT, HORAS, CONHAC) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
    With command
        .ActiveConnection = connection
        .CommandText = strSQL
        .Parameters.Append .CreateParameter("CODIGO", adInteger, adParamInput, 255, CODIGO)
        .Parameters.Append .CreateParameter("FECHA", adDate, adParamInput, 255, FECHA)
        .Parameters.Append .CreateParameter("FECHOR", adDate, adParamInput, 255, FECHOR)
        .Parameters.Append .CreateParameter("CODSUR", adInteger, adParamInput, 255, CODSUR)
        .Parameters.Append .CreateParameter("MATRICULA", adVarChar, adParamInput, 255, MATRICULA)
        .Parameters.Append .CreateParameter("TIPO", adVarChar, adParamInput, 255, TIPO)
        .Parameters.Append .CreateParameter("CANT", adInteger, adParamInput, 255, CANT)
        .Parameters.Append .CreateParameter("PRECIO", adInteger, adParamInput, 255, PRECIO)
        .Parameters.Append .CreateParameter("PREMED", adInteger, adParamInput, 255, PREMED)
        .Parameters.Append .CreateParameter("TOTAL", adInteger, adParamInput, 255, TOTAL)
        .Parameters.Append .CreateParameter("PREVEN", adInteger, adParamInput, 255, PREVEN)
        .Parameters.Append .CreateParameter("MARGEN", adInteger, adParamInput, 255, MARGEN)
        .Parameters.Append .CreateParameter("TOTVEN", adInteger, adParamInput, 255, TOTVEN)
        .Parameters.Append .CreateParameter("FACTURADO", adVarChar, adParamInput, 255, FACTURADO)
        .Parameters.Append .CreateParameter("CODTRA", adInteger, adParamInput, 255, CODTRA)
        .Parameters.Append .CreateParameter("SERFAC", adVarChar, adParamInput, 255, SERFAC)
        .Parameters.Append .CreateParameter("ANNOFAC", adInteger, adParamInput, 255, ANNOFAC)
        .Parameters.Append .CreateParameter("NUMFAC", adInteger, adParamInput, 255, NUMFAC)
        .Parameters.Append .CreateParameter("CODVIA", adInteger, adParamInput, 255, CODVIA)
        .Parameters.Append .CreateParameter("REFERENCIA", adVarChar, adParamInput, 255, REFERENCIA)
        .Parameters.Append .CreateParameter("APUHAC", adInteger, adParamInput, 255, ID)
        .Parameters.Append .CreateParameter("CODPRY", adVarChar, adParamInput, 255, CODPRY)
        .Parameters.Append .CreateParameter("KM", adInteger, adParamInput, 255, KM)
        .Parameters.Append .CreateParameter("COMPLETO", adInteger, adParamInput, 255, COMPLETO)
        .Parameters.Append .CreateParameter("LIQUIDADO", adInteger, adParamInput, 255, LIQUIDADO)
        .Parameters.Append .CreateParameter("CODLIQ", adInteger, adParamInput, 255, CODLIQ)
        .Parameters.Append .CreateParameter("IEP", adInteger, adParamInput, 255, IEP)
        .Parameters.Append .CreateParameter("CODIEP", adInteger, adParamInput, 255, CODIEP)
        .Parameters.Append .CreateParameter("FECIEP", adDate, adParamInput, 255, FECIEP)
        .Parameters.Append .CreateParameter("IMPIEP", adInteger, adParamInput, 255, IMPIEP)
        .Parameters.Append .CreateParameter("MEMO", adVarChar, adParamInput, 255, MEMO)
        .Parameters.Append .CreateParameter("TIPPRE", adVarChar, adParamInput, 255, TIPPRE)
        .Parameters.Append .CreateParameter("VALE", adVarChar, adParamInput, 255, VALE)
        .Parameters.Append .CreateParameter("LITVALE", adInteger, adParamInput, 255, LITVALE)
        .Parameters.Append .CreateParameter("CONCEPTO", adVarChar, adParamInput, 255, CONCEPTO)
        .Parameters.Append .CreateParameter("NUMEXP", adVarChar, adParamInput, 255, NUMEXP)
        .Parameters.Append .CreateParameter("DTOLIT", adInteger, adParamInput, 255, DTOLIT)
        .Parameters.Append .CreateParameter("HORAS", adInteger, adParamInput, 255, HORAS)
        .Parameters.Append .CreateParameter("CONHAC", adVarChar, adParamInput, 255, CONHAC)
        .Execute
    End With
    connection.Close
    Exit Sub
Catch:
    MsgBox "Ha ocurrido un error: " & Err.Description, vbCritical
    Err.Clear
End Sub

Dummy Data:
enter image description here

I'm pretty sure that every data type is matching.

Solution

  • You can open the connection once and use it for all the inserts. Try ;

    Sub InsertAllData()

    Dim wsSampleData As Worksheet, arData, arFields
    Dim conn As ADODB.connection, cmd As New ADODB.command
    Dim sFields As String, strSQL As String
    Dim lastRow As Long, i As Long, j As Long, n As Long
    Dim paraType, paraName As String, sParam As String, size As Long
    
    Set wsSampleData = ThisWorkbook.Sheets("Muestra")
                
    ' field names in header
    arFields = wsSampleData.Range("A1").Resize(, 39)
    
    sFields = arFields(1, 1)
    sParam = "?"
    For n = 2 To UBound(arFields, 2)
       sFields = sFields & "," & arFields(1, n)
       sParam = sParam & ",?"
    Next
      
    ' build SQL
    strSQL = "INSERT INTO CONSUR (" & sFields & ") VALUES (" & sParam & ")"
        
    Set conn = DbConnect()
    Set cmd = New ADODB.command
    With cmd
        .ActiveConnection = conn
        .CommandText = strSQL
        
        For j = 1 To UBound(arFields, 2)
            paraName = arFields(1, j)
            Select Case paraName
               Case "FECHA", "FECHOR", "FECIEP"
                   paraType = adDBTimeStamp
                   size = 0
               Case "CODIGO", "CODSUR", "CANT", "PRECIO", "PREMED", _
                    "TOTAL", "PREVEN", "MARGEN", "TOTVEN", "CODTRA", "ANNOFAC", _
                    "NUMFAC", "CODVIA", "APUHAC", "KM", "COMPLETO", "LIQUIDADO", _
                    "CODLIQ", "IEP", "CODIEP", "IMPIEP", "LITVALE", "DTOLIT", "HORAS"
                   paraType = adInteger
                   size = 0
               Case Else
                   paraType = adVarChar
                   size = 50
            End Select
            .Parameters.Append .CreateParameter(paraName, paraType, adParamInput, size)
        Next
    End With
    
    ' read data and insert
    ReDim arData(1 To UBound(arFields, 2))
    Set wsSampleData = ThisWorkbook.Sheets("Muestra")
    With wsSampleData
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To lastRow
            For j = 1 To UBound(arData)
                If cmd.Parameters(j - 1).Type = adDBTimeStamp Then
                    arData(j) = Format(.Cells(i, j).Value, "yyyy-mm-dd 00:00:00")
                Else
                    arData(j) = .Cells(i, j).Value
                End If
                Debug.Print j, arData(j), cmd.Parameters(j - 1).Name, cmd.Parameters(j - 1).Type
            Next
            ' insert
            'Debug.Print Join(arData, ";")
            cmd.Execute n, arData
        Next
    End With
    conn.Close
    MsgBox "Registros guardados correctamente", vbInformation '
End Sub

Function DbConnect() As ADODB.connection
    Const strConn = "DRIVER={ODBC Driver 17 for SQL Server};" & _
                    "SERVER=Remote-SRV\Instance; DATABASE=localdb; UID=sa; PWD=server;"

    Set DbConnect = New ADODB.connection
    DbConnect.Open strConn
End Function