數據沒有上傳到MS SQL數據庫。

我想推送一個Excel工作表中的按鈕，它應該將數據從工作表發送到SQL表。但是這個vba代碼並沒有將數據從excel上傳到數據庫。我有類似的其他表，它工作正常。任何對此的建議或想法都會很棒。數據沒有上傳到MS SQL數據庫。

子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

來源

2017-08-29 Emily

脫下你的錯誤處理，所以你能看到什麼誤差。你實際上沒有將你的變量定義爲任何類型，例如'bValue'是一個參數，所以期望一個布爾值，所以可能會導致一個問題 –

我同意你不知道錯誤是什麼 – jimmy8ball

你對你的Recordset使用Execute，當你要你的Command對象上使用Execute。

來源

2017-08-29 14:42:31 braX

從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

我的設置看起來像這樣。