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

xyj

发布于 2022-01-18 15:24:20

5631

发布于 2022-01-18 15:24:20

文章被收录于专栏：VBA 学习

历史DB：使用文件选择器来找需要打开的数据库，已经比较方便了。

但是如果是经常使用的数据库，还是希望能够一键就打开，这种时候就需要在菜单上显示出来。

如果是在customUI的xml里直接写进去，又不方便修改，所以更好的方法是在customUI的xml里使用dynamicMenu来动态的添加。

这样就需要有地方保存常用的数据库信息，那保存信息的话自然可以直接在加载宏里保存，因为加载宏本身也是一个Excel，也有工作表，也可以在单元格存储内容，但这样就又把数据和代码放一起了。

既然是操作数据库的程序，那么就用数据库来保存这些信息，我使用的是sqlite数据库来保存：

'动态显示历史打开过的DB，保存在DBOperate.sqlite
Sub dymHistoryDBPath_getContent(control As IRibbonControl, ByRef content)
    Dim HistoryDBPath As Object
    
    If MPublic.dbinfo Is Nothing Then Exit Sub
    
    If MPublic.dbinfo.ExecuteQueryRST("select ID,描述,path,SType from dbpath order by 时间 desc limit 20", HistoryDBPath) Then
        MsgBox MPublic.dbinfo.GetErr()
        Exit Sub
    End If
    If HistoryDBPath.RecordCount = 0 Then
        Exit Sub
    End If
    
    Dim i As Long
    Dim icount As Long
    Dim strXMLs() As String
    ReDim strXMLs(HistoryDBPath.RecordCount - 1) As String
    
    icount = 0
    Do Until HistoryDBPath.EOF
        strXMLs(icount) = "      <button id=""HistoryDB" & VBA.CStr(HistoryDBPath.Fields("ID").Value) & """ label=""" & VBA.CStr(HistoryDBPath.Fields("描述").Value) & """ onAction=""rbdymOpenDB"" imageMso=""FileBackupDatabase"" tag=""" & VBA.Replace(VBA.CStr(HistoryDBPath.Fields("path").Value), "/", "\") & """/>"
        icount = icount + 1
        HistoryDBPath.MoveNext
    Loop
    HistoryDBPath.Close
    
    content = "<menu xmlns=""http://schemas.microsoft.com/office/2006/01/customui"">" & vbNewLine & VBA.Join(strXMLs, vbNewLine) & vbNewLine & "</menu>"
    
End Sub

ExecuteQueryRST是CADO里的一个函数，就是执行一个select语句，将结果返回给Recordset:

Function ExecuteQueryRST(strsql As String, retRST As ADODB.Recordset) As Long
    Dim ret As Long
    On Error GoTo errHandle
    
    ret = RstOpen(strsql, retRST)
    If ret Then
        ExecuteQueryRST = ret
        Exit Function
    End If
    
    ExecuteQueryRST = RetCode.SuccRT
    
    Exit Function
errHandle:
     StrErr = Err.Description
     ExecuteQueryRST = RetCode.ErrRT
End Function

然后遍历整个Recordset，将保存的数据库的dbpath信息构建成customUL的xml语句。

这样dynamicMenu就动态的将常用数据库显示出来，每次需要打开的时候只需要点击dynamicMenu下的按钮菜单即可：

'历史菜单的打开数据库
Sub rbdymOpenDB(control As IRibbonControl)
    If SetDBPath(VBA.CStr(control.Tag)) = SuccRT Then
        '更新时间
        If MPublic.dbinfo.ExecuteNonQuery("update dbpath set 时间=(datetime(CURRENT_TIMESTAMP, 'localtime')) where path='" + DB_Info.Path + "'") Then
            MsgBox MPublic.dbinfo.GetErr
        End If
    
        Erase MPublic.arrCBSql
        rib.InvalidateControl "cbInput"
        '读取sql语句
        If MPublic.dbinfo.ExecuteQueryArr("select strsql||' -- '||commonSQL.描述 from commonSQL, dbpath where dbpath.ID=commonSQL.dbpathID and dbpath.path='" + DB_Info.Path + "'", MPublic.arrCBSql) Then
            MsgBox MPublic.dbinfo.GetErr
        End If
    End If
End Sub

dynamicMenu下的按钮除了打开数据库，还会更新数据库的打开时间，这样动态加载的时候，最近一次打开的就排在第一位。

同时会读取对应的这个数据库保存的一些常用的sql语句，都是为了方便操作。

本文参与腾讯云自媒体同步曝光计划，分享自微信公众号。

原始发表：2022-01-17，如有侵权请联系 cloudcommunity@tencent.com 删除

数据库