[解決済み] VBA - ADODB.CommandTextの実行

質問

私はプログラマーとしての能力が高すぎるという妄想を抱いているので、これを投稿しないと自分に誓っていたのに、こうなってしまった。

先週、ExcelのRangeからMS SQLのTableにデータを書き込むVBA関数をどう書くか考えて投稿した内容を変更しました。これはうまくいきました。

プログラムの最後の方で、コードの最終的な実行をどのように構築すればよいのかわかりません。 Command.Text を上位に設定し、それをレコードセットに設定し、レコードセットを実行しますが、小さなVBAトロールを幸せにするものは何もありません。以下は、現在私が書いているものです。

Sub Connection()
    Dim Tbl As String

    Dim InsertQuery As New ADODB.Command
    InsertQuery.CommandType = adCmdText

    Dim xlRow As Long, xlCol As Integer
    Dim DBconnection As New ADODB.Connection
    Dim ConnString As String
    Dim rst As New ADODB.Recordset
    Dim a As Integer, sFieldName As String
    Dim db As DAO.Database
    Dim CurrentDb As Database
    Dim ConnectionStr

    ConnectionStr = "Provider=sqloledb;Server="";Inital Catalog="";Integrated Security=SSPI;User ID="";Password="""

    DBconnection.Open ConnectionStr

    xlRow = 1   'only one row being used *as of now*, and that is the top row in the excel sheet
    xlCol = 119 'First column of misc. data
    While Cells(xlRow, xlCol) <> ""
        If LH = True Then
            Tbl = "Info.CaseBLH"
            InsertQuery.CommandText = "INSERT INTO " & Tbl & " VALUES('"                
        ElseIf RH = True Then
            Tbl = "Info.CaseBRH"
            InsertQuery.CommandText = "INSERT INTO " & Tbl & " VALUES('"
        Else
            MsgBox ("No available sheets")
            'Application.Quit        
        End If

        NK21Data.TableDefs(Tbl).Fields.Count

        For a = 1 To Fields.Count - 1
            'For xlCol = 119 To 230 'columns DO1 to HV1
            Fields.Item(a) = Replace(Cells(xlRow, xlCol), "'", "''") & "', '" 'Includes mitigation for apostrophes in the data

            If Cells(xlRow, xlCol) = "" Then
                rst.Fields.Item(a) = "NULL"
            End If

            xlCol = xlCol + 1
        Next a
        a = a + 1

        Fields.Item(a) = (Format(Now(), "M/D/YYYY") & "')" & vbCrLf)
    Wend

    'On Error GoTo ErrorHandler
    DBconnection.Execute (InsertQuery.CommandText)

    DBconnection.Close
    Set DBconnection = Nothing

    ErrorHandler:
    If Err.Number <> 0 Then
       Msg = "Error # " & Str(Err.Number) & " was generated by " _
       & Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description
       MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
    End If
End Sub

というエラーが出ます。

コマンドオブジェクトにコマンドテキストが設定されていません。

このエラーは、次の場所で発生します。

DBconnection.Execute (InsertQuery.CommandText)

を使ってみると、以下のようになります。

InsertQuery = DBconnection.Execute

以下のようなエラーが出ます。

引数がオプションでない

3日ほど前から、悪夢にうなされながらやっているので、どなたか、このためにどうしたらいいか、教えていただけると、とてもありがたいです。

どのように解決するのですか？

以前の回答からコードを修正し、きれいにし、動作するようにテストしました。

以下はそのコードです。

Option Explicit


Sub DoItThen()

    Dim i As Integer, sqlIns As String, sqlVals As String
    Dim InsertQuery As New ADODB.Command
    Dim firstRow As Long, firstCol As Integer, lastCol As Integer, currRow As Integer
    Dim DBconnection As New ADODB.Connection
    Dim ConnString As String

    ConnString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=Example;Data Source=MYMACHINENAME"

    DBconnection.Open ConnString

    InsertQuery.ActiveConnection = DBconnection
    InsertQuery.CommandType = adCmdText

    ''build the command text side by side, named columns and values with param placeholders
    sqlIns = "INSERT INTO person("
    sqlVals = " VALUES("

    ''i could work these out by scanning the sheet i suppose. hardcoded for now
    firstRow = 2
    firstCol = 3
    lastCol = 5

    ''generate the SQL - its this that lets the column names come in any order in the sheet
    For i = firstCol To lastCol
        sqlIns = sqlIns & Cells(firstRow, i) & ","
        sqlVals = sqlVals & "?,"
        InsertQuery.Parameters.Append InsertQuery.CreateParameter("p" & i - firstCol, adVarChar, adParamInput, 255)
    Next i

    ''chop off the extra trailing commas and form a syntax correct command
    InsertQuery.CommandText = Left$(sqlIns, Len(sqlIns) - 1) & ")" & Left$(sqlVals, Len(sqlVals) - 1) & ")"

    ''iterate the data part of the sheet and execute the query repeatedlty
    currRow = firstRow + 1
    While Cells(currRow, firstCol) <> ""

       For i = firstCol To lastCol
           InsertQuery.Parameters("p" & i - firstCol).Value = Cells(currRow, i)
       Next i

       InsertQuery.Execute , , adExecuteNoRecords ''dont return a resultset

       currRow = currRow + 1
    Wend


    DBconnection.Close
    Set DBconnection = Nothing

ErrorHandler:
    If Err.Number <> 0 Then
       MsgBox Err.Description
    End If
End Sub

最初の行をdbテーブルのカラム名とする - 順序は問わない

コマンドを作成し、パラメータを入力します。

繰り返し値が入力され、クエリが実行され、テーブルが生成されます。