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表格里了