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

總結

以上是生活随笔為你收集整理的vba ado 连接mysql_Excel VBA 自定义类(ADO)连接数据库的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。