vb调用mysql存储过程_用vb执行数据库的存储过程

Sub 生成《数据质量检查》数据()

' 生成《数据质量检查》数据 Macro

' 宏由 chengyb 录制，时间: 2008-6-12

Dim cmd As New ADODB.Command

Dim rs As New ADODB.Recordset

Dim conn As Connection

Dim result_str As String

Dim i As Integer

Dim index As Integer

Dim index0 As Integer

Dim index1 As Integer

Dim k As Integer

Dim col_name As String

On Error GoTo errh

'Windows("CEB_PLMS数据质量检查报告_Application_data(basel).xls").Activate

'Sheets("目标_房贷").Select

For i = 2 To 39

col_name = Cells(i, 1)

Debug.Print "开始检查" & col_name & "的数据"

Set conn = OpenOraDSN("PLDB_10.1.18.246") '连接数据库字符串

cmd.ActiveConnection = conn '建立命令类和数据库的连接

cmd.CommandType = adCmdStoredProc '定义命令类型为执行存储过程

cmd.CommandText = "checkdata_bak"  '执行存储过程的名字

cmd.Parameters.Append _

cmd.CreateParameter("col_name", adVarChar, adParamInput, 40, col_name) '添加执行存储过程的输入参数col_name为fi_acct_num

cmd.Parameters.Append _

cmd.CreateParameter("tab_name", adVarChar, adParamInput, 40, "vt_basel2_target") '添加执行存储过程的输入参数tab_name为vt_basel2_target

cmd.Parameters.Append _

cmd.CreateParameter("result_str", adVarChar, adParamOutput, 1000) '添加执行存储过程的输出参数result_str

Set rs = cmd.Execute() '执行该存储过程

result_str = cmd.Parameters("result_str").Value

Debug.Print "sjk返回:" & result_str

index = 1

index0 = 1

For k = 1 To 15  '截取字符串

index1 = InStr(index0, result_str, "|")

index = index1 - index0

Cells(i, 5 + k) = Mid(result_str, index0, index)

index0 = index1 + 1

Next k

Set rs = Nothing

Set cmd = Nothing

Debug.Print " 检查" & col_name & "数据结束"

Next i

errh:

MsgBox Err.Description

End Sub

Function OpenOraDSN(Optional dsn As String = "PLDB_10.1.18.246") As Connection

Dim iRet As Long, sDriver As String, sConn As String

Dim sServer As String, sUser As String, sPass As String

Dim c As Connection

On Error GoTo errh

sDriver = "Microsoft ODBC for Oracle"

sConn = "DSN=" & dsn

If SQLConfigDataSource(vbAPINull, ODBC_CONFIG_SYS_DSN, sDriver, sConn) = 0 Then

MsgBox "没有创建名为" & dsn & "的数据源！" & vbCrLf & "点确定后将会引导你创建.(需要先安装oracle客户端，并配置好到数据库服务器的连接)", vbInformation

sServer = InputBox("例如:odsptcs", "请输入Oracle配置的连接服务名", "PLDB_10.1.18.246")

If sServer = "" Then End

sUser = InputBox("例如:plms", "请输入Oracle用户名", "plms")

If sUser = "" Then End

sPass = InputBox("例如:plms", "请输入Oracle用户的密码", "plms")

If sPass = "" Then End

sConn = sConn & Chr(0) & "SERVER=" & sServer & Chr(0) & "UID=" & sUser & Chr(0) & "PWD=" & sPass

iRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_SYS_DSN, sDriver, sConn)

If iRet Then

SaveSetting APPNAME, "DSN", dsn & ".UID", sUser

SaveSetting APPNAME, "DSN", dsn & ".PWD", sPass

MsgBox "数据源DSN创建成功！", vbInformation

Else

MsgBox "数据源DSN创建失败！", vbExclamation

End

End If

Else

sUser = GetSetting(APPNAME, "DSN", dsn & ".UID")

sPass = GetSetting(APPNAME, "DSN", dsn & ".PWD")

Do While sUser = ""

sUser = InputBox("", "请输入Oracle用户名", "plms")

Loop

Do While sPass = ""

sPass = InputBox("", "请输入Oracle用户的密码", "plms")

Loop

SaveSetting APPNAME, "DSN", dsn & ".UID", sUser

SaveSetting APPNAME, "DSN", dsn & ".PWD", sPass

End If

Set c = New Connection

c.Open "DSN=" & dsn, sUser, sPass

Set OpenOraDSN = c

Exit Function

errh:

MsgBox Err.Description, vbCritical, "打开数据库失败"

End

End Function