データは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'はparamですので、ブール値を期待すると問題が発生する可能性があります。 –

エラーが何であるか分からず – jimmy8ball

あなたは、あなたのCommandオブジェクト上Executeを使用しなければならないとき、あなたのRecordsetに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

設定は次のようになります。また