网上大多数有关VBA连接、操作SQL Server数据库的教程，大多是把连接字串、SQL语句、执行过程全写在一个过程中了，当一个VBA项目需要做大量的查询、更新数据时，显然这种方法并不合适，以下代码是把连接、执行过程封装成函数，只要在其他地方用SQL语句作为参数调用查询或者执行的函数就可以了：
Option Explicit'数据源信息常量Public Const conn As String = ""Private IsConnect As Boolean '标记数据库是否连接Public Const CONNECT_LOOP_MAX = 10 '一次执行connect操作，可以访问数据库的次数Private Connect_Num As Integer '标记执行Connect()函数后访问数据的次数Private cnn As Object '连接数据库的 Connection 对象,后期绑定法必须定义为object或者Variant类型Private rst As Object '用来保存结果集的Recordset对象Private cmd As Object '执行数据库操作的Command对象Public Sub Connect() '连接数据库IsConnect = False '如果连接标记为假，标明已经断开连接，则直接返回If IsConnect = True ThenExit SubEnd IfSet cnn = CreateObject("Adodb.Connection") '创建Connection对象cnncnn.ConnectionString = GetConn(conn) '获取数据库的连接字串'On Error Resume NextIf sPing(getHost(conn)) Thencnn.Open'If cnn.State <> adStateOpen Then'判断连接的状态If cnn.State <> 1 ThenMsgBox "主机已开机，但是数据库连接失败"EndEnd If'设置连接标识，表示已经连接到数据库IsConnect = TrueElseMsgBox "未能连接数据库所在的主机"EndEnd IfEnd SubPublic Sub DisConnect() '断开连接数据库'如果连接标记为假，标明已经断开连接，则直接返回If IsConnect = False ThenExit SubEnd If'关闭连接cnn.Close'释放 cnnSet cnn = Nothing'设置连接标记，表示已经断开与数据库的连接IsConnect = FalseEnd SubPublic Function QueryExt(ByVal TmpSQLstmt As String) As Object '数据库查询函数'byval 就是按参数的值传递，再传递过程中，参数不会发生变化(也就是将参数值而不是将地址传递给过程的方式，这就使过程访问变量的副本，过程不可改变变量的值)；'与之对应的是byref,指按参数的地址传值，byref可以省略Set rst = CreateObject("ADODB.Recordset") '创建Rescordset对象rstDB_Connect '连接数据库Set rst.ActiveConnection = cnn '设置rst的ActiveConnection属性,指定与其相关的数据库的连接rst.CursorType = 1 '设置游标类型,后期绑定法必须用数字常量,下同rst.LockType = 3 '设置锁定类型rst.CursorLocation = 3 '使用由本地游标库提供的客户端游标。rst.Open TmpSQLstmt, conn, 1, 3 '打开记录集Set QueryExt = rst '返回记录集End FunctionPublic Sub SQLExt(ByVal TmpSQLstmt As String) '执行数据库操作Set cmd = CreateObject("mand") '创建Command对象cmdConnect '连接数据库Set cmd.ActiveConnection = cnn '设置cmd的ActiveConnect属性，指定与其关联的数据库连接mandText = TmpSQLstmt '设置要执行的命令文本cmd.Execute '执行命令Set cmd = Nothing '释放cmd对象DB_Disconnect '断开与数据库的连接End Sub'================================' VBA中通过WMI对象Ping主机是否连接'' '================================'Function sPing(sHost) As StringFunction sPing(sHost) As BooleanDim oPing As Object, oRetStatus As ObjectSet oPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _("select * from Win32_PingStatus where address = '" & sHost & "'")For Each oRetStatus In oPingIf IsNull(oRetStatus.StatusCode) Or oRetStatus.StatusCode <> 0 Then'sPing = "Status code is " & oRetStatus.StatusCodesPing = FalseElse'sPing = "Pinging " & sHost & " with " & oRetStatus.BufferSize & " bytes of data:" & Chr(10) & Chr(10)'sPing = sPing & "Time (ms) = " & vbTab & oRetStatus.ResponseTime & Chr(10)'sPing = sPing & "TTL (s) = " & vbTab & vbTab & oRetStatus.ResponseTimeToLivesPing = TrueEnd IfNextEnd FunctionFunction getHost(conn) As StringgetHost = Right(conn, Len(conn) - InStr(conn, "Data Source=") - 11)End FunctionFunction GetConn(conn)Dim IP$If conn <> "" ThenGetConn = connExit FunctionElseIP = IP地址If Left(IP, 10) = "192.168.2." Thenconn = "Provider=SQLOLEDB;" & _"Persist Security Info=False;" & _"UID=sa;" & _"PWD=fd28956386887;" & _"Initial Catalog=fdyl;" & _"Data Source=192.168.2.200"Elseconn = "Provider=SQLOLEDB;" & _"Persist Security Info=False;" & _"UID=sa;" & _"PWD=fd28956386887;" & _"Initial Catalog=fdyl;" & _"Data Source=127.0.0.1"End IfGetConn = connEnd IfEnd Function'使用Connect_Num控制数据连接Public Sub DB_Connect()Connect_Num = Connect_Num + 1ConnectEnd Sub'使用Connect_Num控制数据断开Public Sub DB_Disconnect()If Connect_Num >= CONNECT_LOOP_MAX ThenConnect_Num = 0DisConnectEnd IfEnd Sub'强制关闭api方式访问数据库，计数器复位Public Sub DBapi_Disconnect()Connect_Num = 0DisConnectEnd Sub
如果觉得《Excel VBA通过ADO连接 操作SQL Server数据库的自定义函数》对你有帮助，请点赞、收藏，并留下你的观点哦！
