在前面介绍的一些操作数据库的代码中，可以看到，主要的操作逻辑基本上是打开数据库-操作-关闭数据库，很多时候改变的仅仅是操作，所以，把这些封装到一个类里面，以后调用自己写的类就会更方便。
因为ADO这个东西不仅仅只有Excel VBA可以调用，只要能调用COM组件的语言都是可以使用的，所以ADO实现的方法和属性都是通用性的，对于使用Excel VBA的人来说，有些时候为了方便在Excel里使用，自然需要做进一步的处理。
使用VBAProject管理类代码
我个人是习惯使用VBAProject来管理代码的，新建一个.xlam加载宏文件，插入类模块，命名CADO，设置Instancing=2，添加引用：
Microsoft ActiveX Data Objects #.# Library
#.#代表的是版本号，使用自己电脑的最高版本即可。
添加这个引用的目的是为了使用前期绑定，方便输代码，因为使用了VBAProject来管理代码，以后其他文件需要操作数据库都添加引用这个文件即可，不会再需要添加引用ADO。
类模块顶部声明：
代码语言：javascript复制'函数的返回值，0表示成功
Private Enum RetCode
RetSucce = 0
RetErr
End Enum
Private AdoConn As ADODB.Connection
'用来返回错误，通过GetErr函数
Private StrErr As String然后输入类的初始、销毁代码，主要就是声明ADODB.Connection以及关闭数据库：
代码语言：javascript复制Private Sub Class_Initialize()
Set AdoConn = New ADODB.Connection
End Sub
Private Sub Class_Terminate()
If AdoConn.State = adStateOpen Then AdoConn.Close
Set AdoConn = Nothing
End Sub插入模块，命名MAPI，输入代码：
代码语言：javascript复制Public Function NewCADO() As CADO
Set NewCADO = New CADO
End Function准备工作就结束了。
实现OpenDB
打开数据库就是调用ADO的Open方法，在打开的时候，主要是需要写好Provider字符串，前面基本上是使用Excel来做测试的，但是数据库有很多种，不同的数据库Provider字符串是不一样的，希望的OpenDB函数就是可以根据输入的数据库信息，自动构建好Provider字符串：
代码语言：javascript复制Function OpenDB(dbSrc As String) As Long
On Error GoTo errHandle
If AdoConn.State = adStateOpen Then AdoConn.Close
AdoConn.Open GetProvider(dbSrc)
OpenDB = RetCode.RetSucce
Exit Function
errHandle:
StrErr = Err.Description
OpenDB = RetCode.RetErr
End Function
Private Function GetProvider(dbSrc As String) As String
'开头如果是Provider，那就是已经写好了连接语句
If VBA.LCase$(VBA.Left$(dbSrc, 8)) = "provider" Then
GetProvider = dbSrc
Exit Function
End If
'否则按照文件的后缀来处理
Dim strExt As String
strExt = GetExt(dbSrc)
' 没有后缀的文件，尝试使用文件的前面部分字节来判断
If VBA.Len(strExt) = 0 Then strExt = GetExtByBin(dbSrc)
strExt = VBA.LCase$(strExt)
Select Case strExt
Case "xls", "xlsx", "xlsm", "xlsb"
GetProvider = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & dbSrc
GetProvider = GetProvider & ";Extended Properties=""Excel 12.0;HDR=YES"";"
Case "mdb", "accdb"
GetProvider = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & dbSrc
Case "udl"
GetProvider = "File Name=" & dbSrc
Case "sqlite"
'个人习惯使用的sqlite数据库的后缀
GetProvider = "Provider=SQLITEDB;Data Source=" & dbSrc
End Select
End Function
Private Function GetExt(ByVal FullPath As String) As String
Dim i As Long
'先找到文件名，避免一下路径中可能存在的"."
FullPath = GetName(FullPath)
i = VBA.InStrRev(FullPath, ".")
If i Then
GetExt = VBA.Mid$(FullPath, i 1)
Else
GetExt = ""
End If
End Function
Private Function GetName(ByVal FullPath As String) As String
Dim i As Long
i = VBA.InStrRev(FullPath, "")
If i Then
GetName = VBA.Mid$(FullPath, i 1)
Else
GetName = FullPath
End If
End Function
Private Function GetExtByBin(dbPath As String) As String
Dim b() As Byte
ReDim b(&H12) As Byte
ReadTxtByOpenBin dbPath, b
Dim str As String
str = VBA.StrConv(b, vbUnicode)
If VBA.InStr(str, "SQLite format 3") Then
GetExtByBin = "sqlite"
ElseIf VBA.InStr(str, "Standard Jet DB") Then
GetExtByBin = "mdb"
ElseIf VBA.InStr(str, "Standard ACE DB") Then
GetExtByBin = "accdb"
ElseIf VBA.Left$(str, 2) = "PK" Then
'TODO 判断的过于简单
GetExtByBin = "xlsx"
Else
GetExtByBin = ""
End If
End Function
Private Function ReadTxtByOpenBin(txtName As String, b() As Byte) As Long
Dim num_file As Integer
num_file = VBA.FreeFile
Open txtName For Binary Access Read As #num_file
Get #num_file, 1, b
Close #num_file
End FunctionGetProvider函数把一些常用的连接语句都做到了这个函数中，在外部只需要传入对应的文件路径或者是使用udl文件描述的连接语句都可以。
测试：
