A lot of Access users (especially newer ones) like to use the function DLookup to quickly lookup a value from a table or query. It is quite handy shorthand and can be used in VBA and in queries.

The usage of DLookup is:

DLookup (Expr, Domain, Criteria)

Or to put in more Access friendly terms:

Expr is a field name you want.

Domain is a table or query name.

Criteria is what you’d put in the WHERE clause to filter the results.

So you could do something like this to return the phone number of an Employee named “Jon” from the Employees table.

Debug.Print DLookup("PhoneNumber","Employees","FirstName='Jon'")

This is little more readable and easy to type than something like this:

Debug.Print CurrentDb.OpenRecordset("SELECT PhoneNumber FROM Employees WHERE FirstName='Jon'")(0)

Those two statements would return the same result. They are both doing essentially the same thing, opening a new database object, executing a SQL command, and returning the result of that command.

Now the first thing to understand about that is:

1. It’s a very expensive operation.

So this would be very slow to do 1000 times in a loop compared to simple VBA operations.

2. It also does not immediately release the database object it creates.

This is something you’d likely never know unless you’ve experienced the dreaded “Out of Resources” error, but DLookup doesn’t release the database object it creates after it’s done. Garbage collection in Access seems to clean up after it, but calling it recursively in queries or in long code loops can eventually garner you a nice error message which is not at all clear.

To fix this condition, as well as allow a few extra features (like grouping functions and table joins) we have written this function that we use in our HAL library in our Access JumpStart product and affectionately call “Nice” DLookup (NiceDLookup) It tries to behave in a similar manner as far as what it returns in terms of error messages and values and nulls, but it cleans up after itself after each call. Here it is for your viewing pleasure:

' ----------------------------------------------------------------
' Procedure Name: NiceDLookup
' Purpose: Replace the DLookup function so that the new CurrentDB
'          instance will be explicitly closed and released at termination
' Procedure Kind: Function
' Procedure Access: Public
' Parameter Expr (String): {same as DLookup}
' Parameter Domain (String): {same as DLookup}
' Parameter Criteria (Variant): {same as DLookup}
' Return Type: Variant {same as DLookup} Null if no record
'              satisfies criteria or if domain contains no records
' Author: jon
' Date: 2/3/2022
' Modified: 2/9/2022; Throw same error codes as DLookup
' ----------------------------------------------------------------
Public Function NiceDLookup(Expr As String, Domain As String, Optional Criteria As Variant) As Variant
   Dim DbCurrent As DAO.Database, rsTemp As DAO.Recordset
   Dim sCriteria As String, strSQL As String
   Dim newErrNum As Long
   Dim newErrDesc As String

   newErrNum = 0
   NiceDLookup = Null
   On Error GoTo ProcError
   If IsMissing(Criteria) Then
      sCriteria = ""
   ElseIf Criteria = Null Then
      sCriteria = ""
   Else
      sCriteria = Criteria
   End If
   Set DbCurrent = CurrentDb
   strSQL = "SELECT " & Expr & " FROM " & Domain & _
      IIf(sCriteria <> "", " WHERE " & sCriteria, "")
   Set rsTemp = DbCurrent.OpenRecordset(strSQL, dbOpenSnapshot, dbReadOnly)
   If Not (rsTemp.EOF) Then
      NiceDLookup = rsTemp(0)
   End If
ProcExit:
   On Error Resume Next
   rsTemp.Close
   Set rsTemp = Nothing
   DbCurrent.Close
   Set DbCurrent = Nothing
   On Error GoTo 0  ' we will propagate errors as would DLookup
   If newErrNum <> 0 Then
      Err.Raise newErrNum, "NiceDLookup", newErrDesc
   End If
   Exit Function
ProcError:
   ' Process error numbers so that they will be the same as DLookup
   newErrDesc = Err.Description
   Select Case Err.Number
      Case 3061 ' "To few parameters" when Expr or Criteria field name is not found
         newErrNum = 2471  ' what DLookup throws instead
         'newErrDesc = "The expression you entered as a query parameter produced this error: '|'@@@2@1@11805@1"
         If sCriteria = "" Then
            newErrDesc = "The expression you entered as a query parameter produced this error: '" & Expr & "'"
         Else
            newErrDesc = "The expression you entered as a query parameter produced this error: '" & Expr & "' OR '" & Criteria & "'"
         End If
      Case 3078 ' when Domain not found
         newErrNum = 3078  ' same for DLookup
      Case Else ' hopefully everything else will be the same
         newErrNum = Err.Number
   End Select
   Resume ProcExit
End Function

Bonus content: Eric Blomquist took the function and made a few modifications for his own library and sent me a copy. Check it out. He commented each change.

Function NiceDLookup(strExpr As String, strDomain As String, Optional ByVal strCriteria As Variant) As Variant
'	Jon Halder's DLookup() clone, revised and commented by Eric Blomquist, [email protected], [email protected].

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    'Dim strCriteria As String          'Declare the parameter ByVal to permit its revision w/o passback.
    Dim strSQL As String
    
    'NiceDLookup = Null                 'Do below.
    On Error GoTo ErrorProcedure
   
    If IsMissing(strCriteria) Then
        strCriteria = Null              'Exploit the Variant declaration to gain null propagation below.
    'ElseIf strCriteria = Null Then     'Retain any Null.
        'strCriteria = ""
    ElseIf (LenB(strCriteria) = 0) Then 'Handles vbNullString and ZLS (and Null), which a Variant can hold w/o being Missing.
        strCriteria = Null
    Else
        'No other cases.
    End If
   
    Set db = Access.Application.DBEngine(0)(0)  'A direct reference avoids the overhead of a CurrentDB method call, _
                                                 including cycles, memory, and the additional db connections this _
                                                 procedure is intended to conserve.
    'Substituting Null propagation for an IIF() call avoids the overhead of the latter:
    strSQL = "SELECT " & strExpr & " FROM " & strDomain & (" WHERE " + strCriteria)
    Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot, dbReadOnly)
    
    If (rs.EOF) Then        'Initializing a Variant to Null early ordinarily is good practice _
                             but this structure consolidates the assignments concisely, which _
                             is more readable.  Also, avoids a "Not" condition, which is less so. _
                             Also, it conditions the Null assignment, avoiding it and its overhead _
                             when unneccessary.
        NiceDLookup = Null
    Else
        NiceDLookup = rs(0)
    End If
   
ExitProcedure:
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
    On Error GoTo 0  ' we will propagate errors as would DLookup
    If newErrNum > 0 Then                   'A Long can't be <0.
        Err.Raise newErrNum, "NiceDLookup", newErrDesc
    End If
    Exit Function
ErrorProcedure:
    ' Process error numbers so that they will be the same as DLookup
    Dim newErrNum As Long       'Doing here conditions the declaration on an error, conserving RAM.
    Dim newErrDesc As String

    newErrNum = 0
    newErrDesc = Err.Description
    Select Case Err.Number
        Case 3061 ' "To few parameters" when strExpr or strCriteria field name is not found
            newErrNum = 2471  ' what DLookup throws instead
            'newErrDesc = "The strExpression you entered as a query parameter produced this error: '|'@@@2@1@11805@1"
            If (LenB(strCriteria) = 0) Then     'Handles Null, vbNullString, and ZLS.
                newErrDesc = "The strExpression you entered as a query parameter produced this error: '" & strExpr & "'"
            Else
                newErrDesc = "The strExpression you entered as a query parameter produced this error: '" & strExpr & "' OR '" & strCriteria & "'"
            End If
        Case 3078 ' when strDomain not found
            newErrNum = 3078  ' same for DLookup
        Case Else ' hopefully everything else will be the same
            newErrNum = Err.Number
    End Select
    Resume ExitProcedure
End Function    'NiceDLookup()