将 Excel 文件连接到外部数据库以在该数据库中插入一行

问题描述 投票：0回答：1

我正在尝试将 Excel 文件连接到外部数据库以在该数据库中插入一行。

我明白了

编译错误 - [Microsoft][ODBC Driver 17 for SQL Server] 默认参数使用无效

我在该数据库中创建了一个测试表，并且它有效，因此该表一定是问题所在。

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

虚拟数据：

我非常确定每种数据类型都是匹配的。

sql-server excel vba adodb
1个回答
2
投票

您可以打开一次连接并将其用于所有插入件。尝试一下；

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
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.