数据未上传到 MS SQL 数据库。

Question

我正在尝试按下 excel 工作表中的按钮，它应该将数据从工作表发送到 sql 表。但是这个 vba 代码不会将数据从 excel 上传到数据库。我有类似的其他表，它工作正常。对此的任何建议或想法都会很棒。

Sub Send2SQL()

        Dim cmd As New ADODB.Command
        Dim rst As ADODB.Recordset
        Dim UploadTime, SubmissionNumber, WorkbookSection, DataDescription1, DataDescription2, DataDescription3
        Dim iValue, sValue, fValue, bValue, dValue, Omit
        Dim UploadRow As Integer
        Dim LastRow As Integer


        'Establish Error Handler
            On Error GoTo ErrorHandler
        'Determine UploadTime
            UploadTime = Format(Now, "mm\/dd\/yyyy hh\:mm\:ss")
        'Loop Through Upload
        For UploadRow = 2 To LastRow
            With Sheets("DataCapture")
                WorkbookSection = .Cells(UploadRow, WorkbookSectionColumn).Value
                DataDescription1 = .Cells(UploadRow, DataDescription1Column).Value
                DataDescription2 = .Cells(UploadRow, DataDescription2Column).Value
                DataDescription3 = .Cells(UploadRow, DataDescription3Column).Value
                iValue = .Cells(UploadRow, iValueColumn).Value
                sValue = Left(.Cells(UploadRow, sValueColumn).Value, 400)

                If sValue = "" Then sValue = Empty
                fValue = .Cells(UploadRow, fValueColumn).Value
                bValue = .Cells(UploadRow, bValueColumn).Value
                dValue = .Cells(UploadRow, dValueColumn).Value
            End With
            With cmd
                .ActiveConnection = conn
                .CommandType = adCmdStoredProc
                .CommandText = "[DataUpload]"
                .Parameters.Append .CreateParameter("@TimeOfUpload", adDBTimeStamp, adParamInput, , UploadTime)
                .Parameters.Append .CreateParameter("@WorkbookSection", adVarChar, adParamInput, 60, WorkbookSection)
                .Parameters.Append .CreateParameter("@DataDescription1", adVarChar, adParamInput, 255, DataDescription1)
                .Parameters.Append .CreateParameter("@DataDescription2", adVarChar, adParamInput, 60, DataDescription2)
                .Parameters.Append .CreateParameter("@DataDescription3", adVarChar, adParamInput, 60, DataDescription3)
                .Parameters.Append .CreateParameter("@iValue", adBigInt, adParamInput, , iValue)
                .Parameters.Append .CreateParameter("@sValue", adVarChar, adParamInput, 400, sValue)
                .Parameters.Append .CreateParameter("@fValue", adDouble, adParamInput, , fValue)
                .Parameters.Append .CreateParameter("@bValue", adBoolean, adParamInput, , bValue)
                .Parameters.Append .CreateParameter("@dValue", adDate, adParamInput, , dValue)
                .Parameters.Append .CreateParameter("@FileID", adBigInt, adParamInput, , rstOut)
                Set rst = .Execute
            End With
            Set cmd = New ADODB.Command
        Next UploadRow
        'Turn off ErrorHandler & Exit Sub
        On Error GoTo 0
        Exit Sub
        ErrorHandler:
        MsgBox "There was an Error Uploading your data" & vbNewLine & vbNewLine & "An Automated Email has been sent to Sai Latha Suresh from Acturaial"


        On Error GoTo 0



        End
        End Sub

Answer 1

您在您的Recordset 上使用Execute，而您应该在您的Command 对象上使用Execute。

Answer 2

从 Excel 到 SQL Server？试试这个方法。

Sub Rectangle1_Click()
'TRUSTED CONNECTION
    On Error GoTo errH

    Dim con As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim strPath As String
    Dim intImportRow As Integer
    Dim strFirstName, strLastName As String

    Dim server, username, password, table, database As String


    With Sheets("Sheet1")

            server = .TextBox1.Text
            table = .TextBox4.Text
            database = .TextBox5.Text


            If con.State <> 1 Then

                con.Open "Provider=SQLOLEDB;Data Source=" & server & ";Initial Catalog=" & database & ";Integrated Security=SSPI;"
                'con.Open

            End If
            'this is the TRUSTED connection string

            Set rs.ActiveConnection = con

            'delete all records first if checkbox checked
            If .CheckBox1 Then
                con.Execute "delete from tbl_demo"
            End If

            'set first row with records to import
            'you could also just loop thru a range if you want.
            intImportRow = 10

            Do Until .Cells(intImportRow, 1) = ""
                strFirstName = .Cells(intImportRow, 1)
                strLastName = .Cells(intImportRow, 2)

                'insert row into database
                con.Execute "insert into tbl_demo (firstname, lastname) values ('" & strFirstName & "', '" & strLastName & "')"

                intImportRow = intImportRow + 1
            Loop

            MsgBox "Done importing", vbInformation

            con.Close
            Set con = Nothing

    End With

Exit Sub

errH:
    MsgBox Err.Description
End Sub

我的设置如下所示。

另外.......Excel VBA - 更新 SQL Server 表： http://www.cnblogs.com/anorthwolf/archive/2012/04/25/2470250.html

http://www.excel-sql-server.com/excel-sql-server-import-export-using-vba.htm

...更多 http://www.ozgrid.com/forum/showthread.php?t=169953

http://stackoverflow.com/questions/2567150/excel-vba-sql-data

http://msgroups.net/microsoft.public.excel.programming/vba-to-export-large-tables/61433

http://www.codeproject.com/Questions/475817/Howplustoplusupdateplussqlplusserverplusdataplusfr

http://www.excelguru.ca/forums/showthread.php?992-SQL-Select-Insert-Update-queries-from-Excel-vba

http://www.mrexcel.com/forum/excel-questions/617303-updating-records-access-table-using-excel-visual-basic-applications.html

http://www.excelforum.com/excel-programming-vba-macros/501147-how-to-use-vba-to-update-a-sql-server-table-from-a-spreadsheet.html