ExcelVBA自定义类（ADO）连接数据库

ExcelVBA⾃定义类（ADO）连接数据库1.⾸先Excel要引⽤相应的ActiveX库
2.新增⼀个类模块
'class name: adosql for vba use
Option Explicit
Private ObjConnection As New ADODB.Connection
Private ObjCommand As New mand
Public ObjRecordSet As New ADODB.Recordset
Private para(16) As New ADODB.Parameter
Private Sub class_initialize() '构造函数
mandTimeout = 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
mandText = strQUERY
mandType = 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表格⾥了。