Alternative Solution to DCount and DLookup with MS SQL Server Backend
One of the major issues we have encountered with Access is the use of DLookup and DCount when using SQL Server tables. We recently worked on migrating a pure Access solution to SQL server and encountered delays on the loading of several forms. This was due to the use of DLookup and DCount in the VBA code.
We then came up with a solution to quickly resolve the multiple instances with a couple of functions. We were guided by another solution provide by Allen Browne who designed the Extended DLookup here in this link.
Allen’s solution improves the performance of the DLookup by:
- Including a sort order to ensure you get the result you need.
- Cleaning up after itself.
- Correctly differentiates a Null and a zero-length string.
- Overall improvement in performance.
We have now taken this one step further to work specifically with SQL tables or views, these will not work with Access local tables as we are specifically using an ADO connection.
I am including the code for both functions to replace both DLookup and DCount
Public Function ESQLLookup(strField As String, strTable As String, Optional Criteria As Variant, _ Optional OrderClause As Variant) As Variant Dim rs As ADODB.Recordset 'To retrieve the value to find. Dim rsMVF As ADODB.Recordset 'Child recordset to use for multi-value fields. Dim varResult As Variant 'Return value for function. Dim strSQL As String 'SQL statement. Dim strOut As String 'Output string to build up (multi-value field.) Dim lngLen As Long 'Length of string. Const strcSep = "," 'Separator between items in multi-value list. 'Initialize to null. varResult = Null 'Encapsulate Domain in brackets if none exist to allow special characters in the Domain string If Left$(strTable, 1) <> "[" Then strTable = "[" & strTable & "]" End If 'Build the SQL string. strSQL = "SELECT TOP 1 " & strField & " FROM " & strTable If Not IsMissing(Criteria) Then strSQL = strSQL & " WHERE " & Criteria End If If Not IsMissing(OrderClause) Then strSQL = strSQL & " ORDER BY " & OrderClause End If strSQL = strSQL & ";" 'Lookup the value. OpenMyRecordset rs, strSQL, rrOpenForwardOnly, rrLockReadOnly, True If rs.RecordCount > 0 Then 'Will be an object if multi-value field. If VarType(rs(0)) = vbObject Then Set rsMVF = rs(0).Value Do While Not rsMVF.EOF If rs(0).Type = 101 Then 'dbAttachment strOut = strOut & rsMVF!FileName & strcSep Else strOut = strOut & rsMVF![Value].Value & strcSep End If rsMVF.MoveNext Loop 'Remove trailing separator. lngLen = Len(strOut) - Len(strcSep) If lngLen > 0& Then varResult = Left(strOut, lngLen) End If Set rsMVF = Nothing Else 'Not a multi-value field: just return the value. varResult = rs(0) End If End If rs.Close 'Assign the return value. ESQLLookup = varResult ErrEx.Catch 11 ' Division by Zero Debug.Print strSQL MsgBox "To troubleshoot this error, please evaluate the data that is being processed by:" _ & vbCrLf & vbCrLf & strSQL, vbCritical, "Division by Zero Error" ErrEx.CatchAll MsgBox "Error " & err.Number & ": " & err.Description, vbCritical, "Unexpected error" ErrEx.Finally Set rs = Nothing End Function
Public Function ESQLCount(strField As String, strTable As String, Optional Criteria As Variant) As Variant Dim rs As ADODB.Recordset 'To retrieve the value to find. Dim varResult As Variant 'Return value for function. Dim strSQL As String 'SQL statement. Dim lngLen As Long 'Length of string. 'Initialize to null. varResult = Null 'Encapsulate Domain in brackets if none exist to allow special characters in the Domain string If Left$(strTable, 1) <> "[" Then strTable = "[" & strTable & "]" End If 'Build the SQL string. strSQL = "SELECT COUNT(" & strField & ") AS TotalCount FROM " & strTable If Not IsMissing(Criteria) Then strSQL = strSQL & " WHERE " & Criteria End If strSQL = strSQL & ";" 'Lookup the value. OpenMyRecordset rs, strSQL, rrOpenForwardOnly, rrLockReadOnly, True varResult = Nz(rs.Fields("TotalCount"), 0) rs.Close 'Assign the return value. ESQLCount = varResult ErrEx.CatchAll MsgBox "Error " & err.Number & ": " & err.Description, vbCritical, "Unexpected error" Resume Next ErrEx.Finally Set rs = Nothing End Function
If you have an instance that requires the use of DSum then you can easily adapt the DCount function to give you the required result.
After applying this solution we found a dramatic improvement in the performance of the forms loading and the design helps us to apply this solution to multiple projects. I hope this solution is helpful to you and if you have any other issues that we can help you with then please reach out to us at accessexperts.com.
Regarding Brian Thor’s plea for help, his frustrated post is similar to why I’m also posting..
Regarding the much belated “you can update” response by the blog article publisher, I don’t see how using VBWatchdog (I have it) would eliminate the MS Access compile error “User-defined type not defined” which occurs on statement “Dim rs As ADODB.Recordset”.
Regarding the error about type not defined, that is most likely because you don’t have the ADO referenced in your VBA project. For a long while, new Access VBA projects do not have ADO referenced by default and therefore you must add it yourself using VBIDE’s Tools -> References dialog. The library name is “Microsoft ActiveX Data Objects X.Y library.” Normally, there will be multiple versions but we recommend using the latest version which is 6.1.
The OpenMyRecordset() function is also not included in this snippet as well as itd supporting classes (the cached UI.CurrentConnection). While this function is working fast for me (the customer) it is not portable as a stand-alone function.
I also wanted to note that because this function is using ADO instead of DAO, any criteria passed to it with ‘*’ wildcards will need to be changed to ‘%’. No errors are reported when the ‘*’ wildcard is passed so it took me a while to realize that it wasn’t functioning in some form validation code.
I am lost. The functions won’t compile for me because of issues with the OpenMyRecordset statement. This appears to be a missing sub. I found the function in a post by Juan Soto but then I get stuck because error handling doesn’t work. What am I missing?
Hi Brian, sorry for the delay in response. For this particular project we are using VBWatchdog to handle the errors and therefore I have additional modules in the project that are required. You can update the error handler method to use your own code if you do not use VBWatchdog.