Excel function with ADODB connection string to Access database

Question

I've created below Excel function which connects to an access database with ADODB (approx 10k lines). It generally works but there are two main issues:

It is unreliable: often it returns 0 while the result should be different
It is definitely slow

Any suggestion on how to improve?

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

It is very likely unreliable because there are errors. Note that you must remove On Error Resume Next because this line hides all error messages, but the errors still occur, you just cannot see their messages. So if you don't see the errors you cannot fix them and if you don't fix them the code does not work as intended. Remove that line and fix your errors instead. • You might benefit from VBA Error Handling – A Complete Guide. — Pᴇʜ
– Pᴇʜ, Commented Feb 20, 2020 at 7:28
It is probably slow because of your Do loop that loops through all records (if there are many it slows down the process a lot). You obviously just subtract two values and sum them up in total. Try to figure out how to do this in SQL so you don't need to loop. It should be possible with one SQL statement to get that total, without having to loop. — Pᴇʜ
– Pᴇʜ, Commented Feb 20, 2020 at 7:32

ComputerVersteher · Accepted Answer · 2020-03-07 13:37:54Z

3

If Cat, SubCat or Anno are user inputs it is more secure to use parameters in your query. For example

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

edited Mar 7, 2020 at 13:37

ComputerVersteher

2,6941 gold badge12 silver badges21 bronze badges

answered Feb 20, 2020 at 18:26

CDP1802

17.3k2 gold badges10 silver badges19 bronze badges

Sign up to request clarification or add additional context in comments.

6 Comments

Andrew Over a year ago

looks fantastic! thanks! Only I get following error on line "Set rs = .Execute": Microsoft Visual Basic Run-time error '-2147467259 (80004005)': The text fie specifcaton 'Report Link Specifcatonl' does not exist. You cannot import, export, or link using the specifcaton

Andrew Over a year ago

I have Office 2016 Pro, on Win 10 Pro 64 bit

Andrew Over a year ago

Tried once more and now I get this error, still on line "Set rs = .Execute": Run-time error '-2147217904 (80040e10)': Too few parameters. Expected 3.

Andrew Over a year ago

Sure I changed cat,subcat,2020. Anyways now I was able to solve it! There was a typing error in SQL "ddate" instead of "date".

CDP1802 Over a year ago

@Andrew When I created a test database I used ddate for the field name because date is a reserved word. Forgot to change it, doh !

|

Collectives™ on Stack Overflow

Excel function with ADODB connection string to Access database

1 Answer 1

6 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

6 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related