zl程序教程

您现在的位置是:首页 >  数据库

当前栏目

VBA与数据库——写个类操作ADO_操作数据库

2023-03-14 22:39:48 时间

操作数据库有增加、修改、删除、查询记录等,在前面的例子中,用的基本都是查询,这种是需要得到结果数据的,另外几种是修改数据库里的数据,很多时候是不需要返回数据的。

所以抽象出来就是一种需要返回结果,一种不需要,这样2种操作数据库的功能,所以在CADO里面增加2个函数:

Function Execute(StrSql As String) As Long
    On Error GoTo errHandle
    
    AdoConn.Execute StrSql, , adCmdText Or adExecuteNoRecords
    Execute = RetCode.RetSucce
    Exit Function
    
errHandle:
    StrErr = Err.Description
    Execute = RetCode.RetErr
End Function

Function ExecuteQuery(StrSql As String, retRst As ADODB.Recordset, Optional bField As Boolean = True) As Long
    On Error GoTo errHandle
    
    Set retRst = AdoConn.Execute(StrSql, , adCmdText Or adOpenForwardOnly)
    
    ExecuteQuery = RetCode.RetSucce
    
    Exit Function
errHandle:
     StrErr = Err.Description
     ExecuteQuery = RetCode.RetErr
End Function

有了这2个函数,那么在前面例子中的代码就可以进行修改了,直接调用CADO就可以了,比如前面的排序代码:

Sub ADOSortData()
    Dim ado As CADO
    Set ado = NewCADO()
    
    '打开数据库
    If ado.OpenDB(ThisWorkbook.fullname) Then
        Debug.Print ado.GetErr()
        Exit Sub
    End If
     
    Dim rst As Object
    If ado.ExecuteQuery("select * from [Sheet1$A1:B5] order by 数据 asc", rst) Then
        Debug.Print ado.GetErr()
        Exit Sub
    End If
    
    Range("D1").CopyFromRecordset rst

    Set ado = Nothing
End Sub

代码的数量上没有多大变化,但是在使用上就比直接调用ADO对象要方便一些。

因为我们是在Excel里使用,很多时候读取数据库后数据都是输出到单元格中,那么进一步处理CopyFromRecordset,这个也做到CADO里面,增加一个输出到Excel的函数:

Function ResultToExcel(StrSql As String, rng As Range, Optional bField As Boolean = True) As Long
    Dim rst As ADODB.Recordset
    
    ResultToExcel = ExecuteQuery(StrSql, rst, bField)
    If ResultToExcel Then
        Exit Function
    End If
    
    Dim i As Long
    If bField Then
        For i = 0 To rst.Fields.Count - 1
            rng.Offset(0, i).Value = rst.Fields(i).Name
        Next i
        Set rng = rng.Offset(1, 0)
    End If
    
    rng.CopyFromRecordset rst 'AdoConn.Execute(SqlStr)
    ResultToExcel = RetCode.RetSucce
    Exit Function
    
errHandle:
    StrErr = Err.Description
    ResultToExcel = RetCode.RetErr
End Function

然后调用这个函数就更方便了:

Sub ADOSortData()
    Dim ado As CADO
    Set ado = NewCADO()
    
    '打开数据库
    If ado.OpenDB(ThisWorkbook.fullname) Then
        Debug.Print ado.GetErr()
        Exit Sub
    End If
     
    If ado.ResultToExcel("select * from [Sheet1$A1:B5] order by 数据 asc", Range("D1")) Then
        Debug.Print ado.GetErr()
        Exit Sub
    End If

    Set ado = Nothing
End Sub