vba ado 连接mysql_Excel VBA 自定义类(ADO)连接数据库
1.首先Excel要引用相应的ActiveX库
2.新增一个类模块
'class name: adosql for vba use
Option Explicit
Private ObjConnection As New ADODB.Connection
Private ObjCommand As New ADODB.Command
Public ObjRecordSet As New ADODB.Recordset
Private para(16) As New ADODB.Parameter
Private Sub class_initialize() '构造函数
ObjConnection.CommandTimeout = 15
ObjConnection.ConnectionTimeout = 15
End Sub
Public Sub openDsn(strDSN As String) '打开数据库连接
If Len(strDSN) = 0 Then
MsgBox "DSN不能为空."
Exit Sub
End If
If Right(strDSN, 1) = ";" Then
ObjConnection.Open strDSN
Else
ObjConnection.Open strDSN & ";"
End If
End Sub
Public Sub setCmd(strQUERY As String, cmdTYPE As Integer) '设置命令
ObjCommand.ActiveConnection = ObjConnection
ObjCommand.CommandText = strQUERY
ObjCommand.CommandType = cmdTYPE '1-语句 4-存储过程
ObjConnection.CursorLocation = 3 '本地游标库提供的客户端游标
ObjRecordSet.CursorType = 3 '静态游标
End Sub
Public Sub inpara(s As Integer, paname As String, paformat As String, palen As String, pavalue As String) '参数个数 参数名 字符类型 长度 值
Set para(s) = ObjCommand.CreateParameter(paname, paformat, 1, palen, pavalue)
ObjCommand.Parameters.Append para(s)
End Sub
Public Sub inparastr(s As Integer, paname As String, palen As String, pavalue As String) '参数个数 参数名 长度 值
Set para(s) = ObjCommand.CreateParameter(paname, "202", 1, palen, pavalue)
ObjCommand.Parameters.Append para(s)
End Sub
Public Sub inparaint(s As Integer, paname As String, pavalue As String) '参数个数 参数名 值
Set para(s) = ObjCommand.CreateParameter(paname, "3", 1, "8", pavalue)
ObjCommand.Parameters.Append para(s)
End Sub
Public Sub inparadate(s As Integer, paname As String, pavalue As String) '参数个数 参数名 值
Set para(s) = ObjCommand.CreateParameter(paname, "7", 1, "10", pavalue)
ObjCommand.Parameters.Append para(s)
End Sub
Public Sub inparabool(s As Integer, paname As String, pavalue As String) '参数个数 参数名 值
Set para(s) = ObjCommand.CreateParameter(paname, "11", 1, "1", pavalue)
ObjCommand.Parameters.Append para(s)
End Sub
Public Sub inparadec(s As Integer, paname As String, pavalue As String) '参数个数 参数名 值
Set para(s) = ObjCommand.CreateParameter(paname, "14", 1, "18", pavalue)
ObjCommand.Parameters.Append para(s)
End Sub
Public Sub outpara(s As Integer, paname As String, paformat As String, palen As String) '参数个数 参数名 字符类型 长度
Set para(s) = ObjCommand.CreateParameter(paname, paformat, 2, palen)
ObjCommand.Parameters.Append para(s)
End Sub
Public Sub inoutpara(s As Integer, paname As String, paformat As String, palen As String, pavalue As String) '参数个数 参数名 字符类型 长度 值
Set para(s) = ObjCommand.CreateParameter(paname, paformat, 3, palen, pavalue)
ObjCommand.Parameters.Append para(s)
End Sub
Public Function outvalue(s As Integer) As String '返回指定参数返回值
outvalue = para(s).Value
End Function
Public Sub rlspara(s As Integer) '释放参数对象
Dim i As Integer
For i = 1 To s
ObjCommand.Parameters.Delete para(i).Name
Set para(i) = Nothing
Next
End Sub
Public Function execRT() As Integer '执行CMD 并返回记录数
Set ObjRecordSet = ObjCommand.Execute
execRT = CInt(ObjRecordSet.RecordCount)
End Function
Public Function getRT() As ADODB.Recordset '返回记录集
Set getRT = ObjCommand.Execute
End Function
Private Sub mfirst() '游标定位到第一条
ObjRecordSet.MoveFirst
End Sub
Private Sub mnext() '游标定位到下一条
ObjRecordSet.MoveNext
End Sub
Public Function getvalue(fieldname As Integer) As String '取值 BY name
getvalue = ObjRecordSet.Fields(fieldname).Value
End Function
Public Function numvalue(fieldnum As Integer) As String '取值 BY number
numvalue = ObjRecordSet.Fields(fieldnum).Value
End Function
Public Sub clsrcd() '关闭结果集
ObjRecordSet.Close
End Sub
Public Sub clscon() '关闭连接
ObjConnection.Close
End Sub
Public Function scalar(strQUERY As String) As String '返回字符串值
Dim ct As Integer
Call setCmd(strQUERY, 1)
ct = execRT()
If ct > 0 Then
Call mfirst
scalar = numvalue(0)
Else
scalar = ""
End If
Call clsrcd
End Function
Public Sub rlscon() '释放所有对象
Set ObjRecordSet = Nothing
Set ObjCommand = Nothing
if ObjConnection.State = adStateOpen Then
ObjConnection.Close
endif
Set ObjConnection = Nothing
End Sub
Private Sub Class_Terminate() '析构函数
Set ObjRecordSet = Nothing
Set ObjCommand = Nothing
if ObjConnection.State = adStateOpen Then
ObjConnection.Close
endif
Set ObjConnection = Nothing
End Sub
3.新增一个SUB在模块里
测试连接数据库(PROGRESS)
Option Explicit
Public Sub test1()
Dim ado As adosql
Set ado = New adosql
ado.openDsn "Dsn=mfgtest;uid=sql;pwd=123;host=xxx.xx.xx.xx;port=xxxx;db=mfgdb;"
Dim sqlstr As String
sqlstr = "select ifnull(sum(op_qty_comp),0) from pub.op_hist where op_domain = 'CN01' and op_site = 'CN01' and op_type = 'BACKFLSH' and op_date = ? and op_part = ? and op_wo_op = ?"
ado.inparadate 1, "@date", "2020-04-28"
ado.inparastr 2, "@part", "18", "ABC0001"
ado.inparaint 3, "@op", "40"
MsgBox (ado.scalar(sqlstr))
ado.rlspara 3
Set ado = Nothing
End Sub
测试连接数据库(MS SQLSERVER)
Option Explicit
Public Sub test2()
Dim ado As adosql
Set ado = New adosql
ado.openDsn "driver={SQL Server};server=10.3.xxx.x;uid=sql;pwd=xxxx;database=TESTDB"
Dim sqlstr As String
sqlstr = "select isnull(sum(sodqty),0) from salesdetail where plantcode = 'CN01' and orddate >= ?"
ado.inparadate 1, "@date", "2020-04-28"
MsgBox (ado.scalar(sqlstr))
ado.rlspara 3
Set ado = Nothing
End Sub
这样就可以比较方便的取到数据 输出到EXCEL表格里了