Excel +VBA +ADO+Access (CRUD)数据库操作类

新建类模块DBhelper

Option Explicit`

Dim cnn As ADODB.Connection
Dim rs As New ADODB.Recordset


Property Get excel_driver()


  If Val(Application.Version) < 12 Then 'Excel版本为2003及2003以下

        excel_driver = "Provider=Microsoft.Jet.Oledb.4.0;Data Source=" & ActiveWorkbook.Path & "\DataBaseSys.accdb; Jet OLEDB:Database Password=zjy;"

   Else
          
        excel_driver = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ActiveWorkbook.Path & "\DataBaseSys.accdb; Jet OLEDB:Database Password=zjy;"
   End If

 End Property

''初始化数据库

Public Function db_con() As Boolean

    On Error GoTo er

    Set cnn = New ADODB.Connection

    cnn.Open excel_driver

    Exit Function

er:

    db_con = False

    MsgBox "数据库连接失败:" & Err.Description

End Function


 Function query(sql As String) As ADODB.Recordset
  

' If cnn.State <> 1 Then db_con

    '返回记录集

    On Error GoTo er

    Set rs = New ADODB.Recordset

    rs.CursorLocation = adUseClient

    rs.Open sql, cnn, adOpenKeyset, adLockPessimistic

    Set query = rs

    Exit Function

er:

    MsgBox "记录集返回失败:" & Err.Description

End Function


Sub Execute(sql As String)
   cnn.Execute sql
End Sub

Sub BeginTrans()
   cnn.BeginTrans
End Sub
Sub CommitTrans()
   cnn.CommitTrans
End Sub

Sub RollbackTrans()

   cnn.RollbackTrans

End Sub


Function getNewID(tableName As String)
  

    Set rs = New ADODB.Recordset
    
    rs.CursorLocation = adUseClient

    rs.Open "select Max(ID) from " & tableName, cnn, adOpenKeyset, adLockPessimistic

     getNewID = rs.fields(0).value
End Function





'事务回滚
 Sub executeTrans(sqls As Collection)
  
 Dim i As Long

    cnn.BeginTrans
    On Error GoTo er
   For i = 1 To CLng(sqls.Count)
     cnn.Execute sqls(i)
   Next

   cnn.CommitTrans
   Set cnn = Nothing
  Set rs = Nothing
  Exit Sub
er:
    cnn.RollbackTrans
    MsgBox "事务sql执行失败:" & Err.Description
    cnn.Close
    Set cnn = Nothing
    Set rs = Nothing
    
End Sub

Function sqlForInsert(tableName As String, fields As Variant, values As Variant)

   Dim sql As String
   Dim c As Integer
    sql = "insert into " & tableName & "("
      
     For c = LBound(fields) To UBound(fields)
     
    sql = sql & fields(c) & IIf(c = UBound(fields), ")", ",")
    Next
    
    sql = sql & " VALUES('"
    For c = LBound(values) To UBound(values)
    
    sql = sql & values(c) & IIf(c = UBound(values), "')", "','")

    Next

  sqlForInsert = sql

End Function

Function sqlForUpdate(tableName As String, fields As Variant, values As Variant)

   Dim sql As String
   Dim c As Integer
    sql = "Update  " & tableName & " set "
      
     For c = LBound(fields) To UBound(fields)
     
    sql = sql & fields(c) & "='" & values(c) & IIf(c = UBound(fields), "'", "',")
    Next
    
   

  sqlForUpdate = sql

End Function
Private Sub Class_Initialize()

db_con
 
End Sub

Private Sub Class_Terminate()

Set cnn = Nothing
Set rs = Nothing

End Sub