VB6.0 调用存储过程的例子方法二

代码整理如下，你可以直接将该代码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