次の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の特定のセルに挿入することですが、その方法がわかりません。誰もこれを以前にやったことがありますか?
ありがとうございました