具有ADODB连接字符串的Excel函数到Access数据库

Question

我已经在Excel函数下面创建了该函数，该函数使用ADODB（大约1万行）连接到Access数据库。它通常可以工作，但是有两个主要问题：

1. 不可靠：通常返回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

Answer 1

如果用户输入的是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