In some of the operations database code introduced earlier, we can see that the main operation logic basically is to open the database - operate - close the database, and many times change is just operation. So, encapsulating these into a class and calling the class that you write later will be more convenient.

Because ADO is not only called by Excel VBA, but also can be used as long as the language that can call COM components. Therefore, the methods and properties implemented by ADO are universal. For those who use Excel VBA, sometimes in order to facilitate their use in Excel, they naturally need to be further processed.

Using VBAProject to manage class code

Personally, I am used to using VBAProject to manage code. Create a new. xlam add in file, insert a class module, name CADO, set Instancing=2, and add references:

Microsoft ActiveX Data Objects #.# Library

#. # represents the version number. You can use the highest version of your computer.

The purpose of adding this reference is to use the early binding and facilitate code input, because VBAProject is used to manage the code. In the future, other files need to add reference to this file in the operation database, and there is no need to add reference ADO.

Class module top declaration:

'The return value of the function. 0 indicates success
Private Enum RetCode
    RetSucce = 0
    RetErr
End Enum
Private AdoConn As ADODB.Connection
'Used to return an error through GetErr function
Private StrErr As String

Then enter the initial and destruction codes of the class, mainly declaring ADODB.Connection and closing the database:

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

Insert the module, name MAPI, and enter the code:

Public Function NewCADO() As CADO
    Set NewCADO = New CADO
End Function

The preparations are over.

Implement OpenDB

To Open a database is to call the Open method of ADO. When you Open it, you mainly need to write the Provider string. Basically, Excel is used for testing, but there are many kinds of databases. Different database Provider strings are different. The desired OpenDB function is to automatically build the Provider string according to the entered database information:

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
    'If yes at the beginning Provider，That is, the connection statement has been written
    If VBA.LCase$(VBA.Left$(dbSrc, 8)) = "provider" Then
        GetProvider = dbSrc
        Exit Function
    End If
    
    'Otherwise, it shall be handled according to the suffix of the file
    Dim strExt As String
    strExt = GetExt(dbSrc)
'    For files without suffix, try to use the first bytes of the file to judge
    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"
        'Personal habit sqlite Suffix of database
        GetProvider = "Provider=SQLITEDB;Data Source=" & dbSrc
        
    End Select
End Function

Private Function GetExt(ByVal FullPath As String) As String
    Dim i As Long
    'Find the file name first to avoid possible errors in the path"."
    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 The judgment is too simple
        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 Function

The GetProvider function implements some common connection statements. In this function, you only need to pass in the corresponding file path or the connection statements described by udl files.

Test: