** VB6.0 ** ** 调用存储过程的例子（方法二）
本人推荐使用方法一来取存储过程，当然前提是知道将要使用的参数化命令的详细情况，通过在代码中创建参数，其执行的速度快。
如果不知道要使用的参数化命令，本人整理了一份通过使用参数（ Parameters ）对象来获取存储过程的记录集的内容，但该执行方式速度没有方法一理想。
代码整理如下，你 可以直接将该代码 Copy 到 Form1 窗体中 进行调试。
其中函数 GetDataType 可以修改为自己所需的处理方式，在这里所有的代码都是为了测试方便所有，你也可以改为自己所需的相应处理。
Sub CreateParms()
Dim ADOCmd As New ADODB.Command
Dim ADOPrm As New ADODB.Parameter
Dim ADOCon As ADODB.Connection
Dim ADORs As ADODB.Recordset
Dim strConnect As String
Dim strFieldName As String
Dim i As Integer
strConnect = "driver={SQL Server};server=(local);uid=sa;pwd=;database=pubs"
Set ADOCon = New ADODB.Connection
With ADOCon
.Provider = "MSDASQL"
.CursorLocation = adUseServer 'Must use Server side cursor.
.ConnectionString = strConnect
.Open
End With
Set ADOCmd.ActiveConnection = ADOCon
With ADOCmd
.CommandType = adCmdStoredProc
.CommandText = "ADOTestRPE"
.Parameters.Refresh ' 指定 ADO 实际地与数据源相连
End With
' 通过 Parameters 对象，填充输入参数
For Each ADOPrm In ADOCmd.Parameters
If ADOPrm.Direction = adParamInput Then
ErrDataType:
On Error Resume Next
ADOPrm.Value = InputBox(" 存储过程参数名称 :" & ADOPrm.Name & vbCrLf & _
" 该参数数据类型 :" & GetDataType(ADOPrm.Type), " 请输入参数值 ", "")
If Err <> 0 Then
If MsgBox(" 所输入的参数与该参数数据类型不符，请重新输入！取消将退出存储过程的调用！ ", vbOKCancel, " 警告 ") = vbCancel Then
Exit Sub
End If
Err.Clear
GoTo ErrDataType
End If
On Error GoTo 0
End If
Next
On Error GoTo ErrHandler
Set ADORs = ADOCmd.Execute
If Not (ADORs Is Nothing) Then
If Not ADORs.EOF Then
Do Until ADORs.EOF
For i = 0 To ADORs.Fields.Count - 1
strFieldName = ADORs.Fields(i).Name
Debug.Print "" & ADORs(strFieldName) & Space(4)
Next
Debug.Print
ADORs.MoveNext
Loop
End If
End If
ErrHandler:
Call ErrHandler(ADOCon)
Resume Next
Shutdown:
Set ADOCmd = Nothing
Set ADOPrm = Nothing
Set ADORs = Nothing
Set ADOCon = Nothing
End Sub
Private Sub Command1_Click()
Call CreateParms
End Sub
Sub ErrHandler(objCon As Object)
Dim ADOErr As ADODB.Error
Dim strError As String
For Each ADOErr In objCon.Errors
strError = "Error #" & ADOErr.Number & vbCrLf & ADOErr.Description _
& vbCr & _
" (Source: " & ADOErr.Source & ")" & vbCr & _
" (SQL State: " & ADOErr.SQLState & ")" & vbCr & _
" (NativeError: " & ADOErr.NativeError & ")" & vbCr
If ADOErr.HelpFile = "" Then
strError = strError & " No Help file available" & vbCr & vbCr
Else
strError = strError & " (HelpFile: " & ADOErr.HelpFile & ")" _
& vbCr & " (HelpContext: " & ADOErr.HelpContext & ")" & _
vbCr & vbCr
End If
' Debug.Print strError
MsgBox strError
Next
objCon.Errors.Clear
End Sub
Function GetDataType(ByRef DataType As DataTypeEnum) As String
Select Case DataType
Case DataTypeEnum.adArray
GetDataType = "DataTypeEnum.adArray"
Case DataTypeEnum.adBigInt
GetDataType = "DataTypeEnum.adBigInt"
Case DataTypeEnum.adBinary
GetDataType = "DataTypeEnum.adBinary"
Case DataTypeEnum.adBoolean
GetDataType = "DataTypeEnum.adBoolean"
Case DataTypeEnum.adBSTR
GetDataType = "DataTypeEnum.adBSTR"
Case DataTypeEnum.adChapter
GetDataType = "DataTypeEnum.adChapter"
Case DataTypeEnum.adChar
GetDataType = "DataTypeEnum.adChar"
Case DataTypeEnum.adCurrency
GetDataType = "DataTypeEnum.adCurrency"
Case DataTypeEnum.adDate
GetDataType = "DataTypeEnum.adDate"
Case DataTypeEnum.adDBDate
GetDataType = "DataTypeEnum.adDBDate"
Case DataTypeEnum.adDBTime
GetDataType = "DataTypeEnum.adDBTime"
Case DataTypeEnum.adDBTimeStamp
GetDataType = "DataTypeEnum.adDBTimeStamp"
Case DataTypeEnum.adDecimal
GetDataType = "DataTypeEnum.adDecimal"
Case DataTypeEnum.adDouble
GetDataType = "DataTypeEnum.adDouble"
Case DataTypeEnum.adEmpty
GetDataType = "DataTypeEnum.adEmpty"
Case DataTypeEnum.adError
GetDataType = "DataTypeEnum.adError """
Case DataTypeEnum.adFileTime
GetDataType = "DataTypeEnum.adFileTime """
Case DataTypeEnum.adGUID
GetDataType = "DataTypeEnum.adGUID"
Case DataTypeEnum.adIDispatch
GetDataType = "DataTypeEnum.adIDispatch"
Case DataTypeEnum.adInteger
GetDataType = "DataTypeEnum.adInteger"
Case DataTypeEnum.adIUnknown
GetDataType = "DataTypeEnum.adIUnknown"
Case DataTypeEnum.adLongVarBinary
GetDataType = "DataTypeEnum.adLongVarBinary"
Case DataTypeEnum.adLongVarChar
GetDataType = "DataTypeEnum.adLongVarChar"
Case DataTypeEnum.adLongVarWChar
GetDataType = "DataTypeEnum.adLongVarWChar"
Case DataTypeEnum.adNumeric
GetDataType = "DataTypeEnum.adNumeric"
Case DataTypeEnum.adPropVariant
GetDataType = "DataTypeEnum.adPropVariant"
Case DataTypeEnum.adSingle
GetDataType = "DataTypeEnum.adSingle"
Case DataTypeEnum.adSmallInt
GetDataType = "DataTypeEnum.adSmallInt"
Case DataTypeEnum.adTinyInt
GetDataType = "DataTypeEnum.adTinyInt"
Case DataTypeEnum.adUnsignedBigInt
GetDataType = "DataTypeEnum.adUnsignedBigInt"
Case DataTypeEnum.adUnsignedInt
GetDataType = "DataTypeEnum.adUnsignedInt"
Case DataTypeEnum.adUnsignedSmallInt
GetDataType = "DataTypeEnum.adUnsignedSmallInt"
Case DataTypeEnum.adUnsignedTinyInt
GetDataType = "DataTypeEnum.adUnsignedTinyInt"
Case DataTypeEnum.adUserDefined
GetDataType = "DataTypeEnum.adUserDefined"
Case DataTypeEnum.adVarBinary
GetDataType = "DataTypeEnum.adVarBinary"
Case DataTypeEnum.adVarChar
GetDataType = "DataTypeEnum.adVarChar"
Case DataTypeEnum.adVariant
GetDataType = "DataTypeEnum.adVariant"
Case DataTypeEnum.adVarNumeric
GetDataType = "DataTypeEnum.adVarNumeric"
Case DataTypeEnum.adVarWChar
GetDataType = "DataTypeEnum.adVarWChar"
Case DataTypeEnum.adWChar
GetDataType = "DataTypeEnum.adWChar"
Case Else
GetDataType = " 无法获取数据类型 "
End Select
End Function