Excel 使用 ADODB 连接字符串到 Access 数据库的函数

Excel function with ADODB connection string to Access database

我在下面创建了 Excel 函数,它使用 ADODB 连接到访问数据库(大约 10k 行)。 它通常有效,但有两个主要问题:

  1. 不可靠:通常是 returns 0 而结果应该不同
  2. 肯定很慢

有什么改进建议吗?

Public Function TotaleSQL(Cat As String, SubCat As String, Anno As Integer) As Long
    On Error Resume Next

    Dim cn As Object, rs As Object, output As String, sql As String
    Dim src As String
    Dim Total As Long
    Dim CatLong As String

    src = "Z:\Report.accdb"

    '---Connecting to the Data Source---
    Set cn = CreateObject("ADODB.Connection")
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .connectionstring = "Data Source=" & src & ";Persist Security Info=False"
        .Open
    End With


    '---Run the SQL SELECT Query---
    CatLong = "'" & Cat & ":" & SubCat & "'"
    sql = "SELECT Report.Withdrawal, Report.Deposit, Report.Category, Report.Date FROM Report WHERE (((Report.Category)=" & CatLong & ") AND ((Year([date]))=" & Anno & "));"

    'sql = "SELECT * FROM [Sheet1$]"
    Set rs = cn.Execute(sql)

    Total = 0

    Do
       Total = Total + Val(rs(1) & "") - Val(rs(0) & "")
       rs.Movenext
    Loop Until rs.EOF

    '---Clean up---
    rs.Close
    cn.Close
    Set cn = Nothing
    Set rs = Nothing

    TotaleSQL = Total
End Function

如果 Cat、SubCat 或 Anno 是用户输入,那么在查询中使用参数会更安全。例如

Public Function TotaleSQL(Cat As String, SubCat As String, Anno As Integer)

    Const DATABASE = "Z:\Report.accdb"
    Const TABLE_NAME = "Report"

    Const SQL = " SELECT SUM(iif(Deposit is null,0,Deposit) " & _
                "        - iif(Withdrawal is null,0,Withdrawal)) " & _
                " FROM " & TABLE_NAME & _
                " WHERE Category   = ? " & _
                " AND   YEAR(ddate)= ? "

    Dim cn As Object, cmd As Object, rs As Object
    '---Connecting to the Data Source---
    Set cn = CreateObject("ADODB.Connection")
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .connectionstring = "Data Source=" & DATABASE & ";Persist Security Info=False"
        .Open
    End With

    ' create command
    Set cmd = CreateObject("ADODB.Command")
    With cmd
        .ActiveConnection = cn
        .CommandText = SQL
        .CommandType = 1 'adCmdText
        .Parameters.Append .CreateParameter("P1", 200, 1, 50) ' 1=adParamInput 200=adVarChar
        .Parameters.Append .CreateParameter("P2", 3, 1) ' 3=adInteger
    End With

    ' execute with parameters
    With cmd
        .Parameters(0).Value = Cat & ":" & SubCat
        .Parameters(1).Value = Anno
        Set rs = .Execute
    End With

    TotaleSQL = rs(0)

    rs.Close
    cn.Close
    Set cn = Nothing
    Set rs = Nothing
    Set cmd = Nothing

End Function

Sub test()
    Debug.Print TotaleSQL("Cat", "SubCat", 2020)
End Sub