0

次のvbaルーチンがあります

Private Sub cmdStartDate_Click()

'Set Variables
Dim conn As ADODB.Connection
Dim str As String
Dim exeStr As String
Dim rs As ADODB.Recordset
Dim fld
Dim i As Integer
Dim connStr As String
Dim cmd As New ADODB.Command


'Error Handler
On Error GoTo errlbl

'Open the database connection
Set conn = New ADODB.Connection

'Construct the connection string
conn = "Driver={SQL Server};Server=10.50.50.140;Database=tbjc;UID=oe;PWD=Orth03c0"

'Open the connection
conn.Open

'Create the command object
Set cmd = New ADODB.Command


'Create and store the start date parameter
With cmd
    .CommandText = "dbo.cusUltrasoundReport"
    .CommandType = adCmdStoredProc
    .Parameters.Append .CreateParameter("@Start", adVarChar, adParamInput, 12, txtStartDate.Text)
    .Parameters("@Start").Value = txtStartDate.Text
    .ActiveConnection = conn
End With

'Create the recordset
Set rs = cmd.Execute

'str = txtStartDate.Text

'exeStr = "exec dbo.UltrasoundReport(" & str & ")"

'Open recordset
'rs.Open

If Not IsEmpty(rs) Then
    rs.MoveFirst

    'Populate the first row of the sheet with recordset's field name
    i = 0
    For Each fld In rs.Fields
        Sheet1.Cells(1, i + 1).Value = rs.Fields.Item(i).Name
        i = i + 1
    Next fld



    'Populate the sheet with the data from the recordset
    Sheet1.Range("A49:Q49").CopyFromRecordset rs
Else
    MsgBox "Unable to open recordset, or unable to connect to database.", vbCritical, "Can't get requested records"
End If

'Cleanup
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing

exitlbl:
Debug.Print "Error: " & Err.Number
    If Err.Number = 0 Then
        MsgBox "Done", vbOKOnly, "All Done."
    End If
Exit Sub

errlbl:
MsgBox "Error #: " & Err.Number & ", Description: " & Err.Description, vbCritical,    "Error in OpenConnection()"
Exit Sub

Resume exitlbl

End Sub

情報を取得してパラメーターをsprocに渡すことは問題なく機能します

私がする必要があるのは、各フィールド値をExcelの特定のセルに挿入することですが、その方法がわかりません。誰もこれを以前にやったことがありますか?

ありがとうございました

4

1 に答える 1