其中函数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