A function that replicates DLookup, and can use parameterized queries

Question 1

This function was built to replace DLookup so that i could pass in parameterized queries for a speed increase. I also wanted a simple way to get more than one value if needed. For example, if i want 4 or 5 fields out of a particular record or maybe 4 or 5 records with only one field, I could get that with this function.

EDIT: the whole filter string portion of the fuction is legacy functionality from when i initially built this function and had to leave in untill all of the places that use this piece of code have been updated.

Public Function Qlookup(ByVal argQuery As String, Optional ByRef argParameters As Variant = Null, Optional ByVal argIsFilterString As Boolean = False) As Variant
    'Parameters -
    'argQuery: the query definition name
    'argParameters: the list of parameters (can come in an array or not) that should be in the order and starting at 0
    'argIsFilterString: Allows you to use a 'Where' Clause instead of a parameter list
    'that the parameters in your query are.
    'Output -
    'Will output a single item, 1d array or 2d array depending on the query you feed it.
    'This comment line is here to fix the formatting messing up.
    If Not BasicInclude.DebugMode Then On Error GoTo Error_Handler
    Dim rs As DAO.Recordset
    Dim qry As QueryDef
    Dim u As Long
    Dim out() As Variant
    Dim i As Long
    Dim j As Long
    Qlookup = Null
    Set qry = dbLocal.QueryDefs(argQuery)
    If argIsFilterString Then
        Set rs = qry.OpenRecordset(dbOpenSnapshot)
        rs.filter = argParameters
        Set rs = rs.OpenRecordset(dbOpenSnapshot)
    Else
        If IsArray(argParameters) Then
            u = UBound(argParameters)
            If u = (qry.Parameters.count - 1) Then
                For i = 0 To u
                    qry.Parameters(i).value = argParameters(i)
                Next i
            Else
                Err.Raise vbObjectError, "Qlookup", "Number of Parameters in query(" & qry.Parameters.count & ") do not match the number of parameters passed in(" & u + 1 & ")"
            End If
        Else
            If Not (IsNull(argParameters)) And qry.Parameters.count = 1 Then
                qry.Parameters(0).value = argParameters
            ElseIf qry.Parameters.count = 0 And Not (IsNull(argParameters)) Then
                Err.Raise vbObjectError + 1, "Qlookup", "Number of Parameters in query(" & qry.Parameters.count & ") do not match the number of parameters passed in(1)"
            ElseIf qry.Parameters.count = 0 And (IsNull(argParameters)) Then
            End If
        End If
        Set rs = qry.OpenRecordset(dbOpenSnapshot)
    End If
    If rs.RecordCount Then
        rs.MoveFirst
        rs.MoveLast
        rs.MoveFirst
        If rs.RecordCount > 1 Then
            If rs.Fields.count > 1 Then
                ReDim out(rs.RecordCount - 1, rs.Fields.count - 1)
                For i = 0 To rs.RecordCount - 1
                    For j = 0 To rs.Fields.count - 1
                        out(i, j) = rs.Fields(j).value
                    Next
                    rs.MoveNext
                Next
            Else
                ReDim out(rs.RecordCount - 1)
                For i = 0 To rs.RecordCount - 1
                    out(i) = rs.Fields(0).value
                    rs.MoveNext
                Next
            End If
            Qlookup = out
        Else
            If rs.Fields.count > 1 Then
                ReDim out(rs.RecordCount - 1, rs.Fields.count - 1)
                For i = 0 To rs.RecordCount - 1
                    For j = 0 To rs.Fields.count - 1
                        out(i, j) = rs.Fields(j).value
                    Next
                    rs.MoveNext
                Next
                Qlookup = out
            Else
                Qlookup = rs.Fields(0).value
            End If
        End If
    End If
Error_Exit:
    Set rs = Nothing
    Set qry = Nothing
    Exit Function
Error_Handler:
    StandardErrorBox "Qlookup", Err, Errors
    Qlookup = Null
    Resume Error_Exit
End Function

Question 2

I’m going to cover other points that aren’t covered…

Unnecessary recordset movement

You have this:

If rs.RecordCount Then
    rs.MoveFirst
    rs.MoveLast
    rs.MoveFirst
    ...
End If

This is totally unnecessary and also problematic:

RecordCount is not the most idiomatic way of checking for an empty. EOF is more common and is usually effective. It also works in both DAO and ADO; I’m a big advocate of writing code that is portable and consistent; it means less thing to remembers and less surprises when one quirky thing that works in one library doesn’t in other.
MoveLast in order to get a count. You already know that RecordCount doesn’t return accurate count until you’ve accessed all records in the recordset. But the more important question to ask yourself is: Did you really need that? I assert that 99% of time you don’t. You have two options at your disposal:

1) Use GetRows method to extract an array out of recordset.

2) Use either a VBA.Collection or Scripting.Dictionary and stop caring about how many records there are; just use a Do Until rs.EOF loop and insert it into the dynamic collection variable.

The point being, you do not need to know the count of the records to do what you need. Eliminate that from your procedure and it becomes much more simpler and also less error-prone.

Do loop instead of For loop

In similar vein you have this code:

For i = 0 To rs.RecordCount - 1
    out(i) = rs.Fields(0).Value
    rs.MoveNext
Next

You need to stop caring about how many iterations you need to do. This is much less verbose and easier to understand:

Do Until rs.EOF
    'do something
    rs.MoveNext
Loop

No local variables is needed just to iterate; nor do you need to care about count to iterate. You just keep iterating until…. you get to the end!

Unnecessary branching

Others already commented on the need to extract functionality into smaller functions and I fully agree. I want to call your attention to this:

    If rs.RecordCount > 1 Then
        If rs.Fields.count > 1 Then
            ReDim out(rs.RecordCount - 1, rs.Fields.count - 1)
            For i = 0 To rs.RecordCount - 1
                ...
            Next
        Else
            ReDim out(rs.RecordCount - 1)
            For i = 0 To rs.RecordCount - 1
                ...
            Next
        End If
        ...
    Else
        If rs.Fields.count > 1 Then
            ReDim out(rs.RecordCount - 1, rs.Fields.count - 1)
            For i = 0 To rs.RecordCount - 1
                ...
            Next
            ...
        Else
            ...
        End If
    End If

Note how all branch, except for very last one basically do the same thing. In fact, the last one is only special since it’s only one column. But do we really care? I say no. All you really want to do is this:

Do Until rs.EOF
    For Each fld In rs.Fields
       ...
    Next
    rs.MoveNext
Loop

This does the same thing as the above branches would have done and does so in much less verbose manner and will work whether there’s only one column or several, only one records or several records. Heck, it even works even if there’s no records!

So in short, you’ve been a victim of being obliged to hold the compiler’s hand and painstakingly tell it each individual step it must do instead of stepping back and see what you are really trying to do, and convey it to the compiler in most idiomatic manner. It’s literally the compiler’s job to make sense of the above instructions into machine operations which are mind-numbingly detailed well beyond the point of boredom. In fact, it’s also the database engine’s job to figure out what you want and how to get it to you in most efficient manner. So you want to step back and be a bit more “declarative”¹ in your programming.

Legacy Support

You have this section:

If argIsFilterString Then
    Set rs = qry.OpenRecordset(dbOpenSnapshot)
    rs.filter = argParameters
    Set rs = rs.OpenRecordset(dbOpenSnapshot)
Else
    ...
End If

Which you already indicated is there for backward compatibility. But as others have alluded to, that only add noise and make it hard to understand your function. Note that even if you’re the only one writing and reading this code, future you won’t know what the hell past you were doing/thinking. So if you don’t want your future you to go back and kill the past you, you owe it to your future you to make it easy to ready. One easy way to set up for legacy support would be to do something akin to this:

Public Function Everything(A As Foo, B As Bar) As Baz
  If B Then
    Everything = EverythingLegacy(A, B)
  Else 
    Everything = EverythingCurrent(A)
  End If
End If

Private Function EverythingLegacy(A As Foo, B As Bar) As Baz
...
End Function

Private Function EverythingCurrent(A As Foo) As Baz
...
End Function

This gives you two big wins:

1) The code for Everything function is immediately much easier to read and make sense. The B parameter which is only used for legacy becomes more obvious.

2) It’s now easy to test the individual functions without having to change the implementation and you know that changes you make won’t break the legacy implementation when you tweak your current implementation. When you’ve finished removing all the legacy implementation, then it’s easy to delete the legacy implementation and make EverythingCurrent the new Everything.

—

1 Technically speaking, that’s inaccurate because VBA is an imperative language whereas SQL is a declarative language, so I use the term loosely in the sense that you need to focus on describing the problem rather than outlining the steps yourself and getting lost in the forest of details.

Question 3

Declaring qry As QueryDef is unnecessarily limiting your function to Queries. With a few changes the function could be ran against Queries or Tables.

Dim qry As Object 'QueryDef or TableDef
On Error Resume Next
Set qry = dbLocal.QueryDefs(argQuery)
On Error GoTo 0

If qry Is Nothing Then
    On Error Resume Next
    Set qry = dbLocal.TableDefs(argQuery)
    On Error GoTo 0
End If

....
If TypeName(qry) = "QueryDef" Then
    If IsArray(argParameters) Then

I would separate this the If clause below to reduce the reduce the number of nesting levels.

If rs.RecordCount Then
    rs.MoveFirst
    rs.MoveLast
    rs.MoveFirst

The first rs.MoveFirst isn’t needed.

If rs.RecordCount = -1 Then
    rs.MoveLast
    rs.MoveFirst
End If

The function should only be set to null after you determine that there are no records.

If rs.RecordCount = 0 Then
    Qlookup = Null
    Exit Function
End If

Since the function will now return out no matter what, I would move Qlookup = out to the last line before clean up.

There is some repeat code that can be eliminated by tweaking some of the If statements.

If rs.RecordCount > 1 Or rs.Fields.Count > 1 Then
    ReDim out(rs.RecordCount - 1, rs.Fields.Count - 1)
    For i = 0 To rs.RecordCount - 1
        For j = 0 To rs.Fields.Count - 1
            out(i, j) = rs.Fields(j).Value
        Next
        rs.MoveNext
    Next
ElseIf rs.Fields.Count > 1 Then
    ReDim out(rs.RecordCount - 1)
    For i = 0 To rs.RecordCount - 1
        out(i) = rs.Fields(0).Value
        rs.MoveNext
    Next
Else
    Qlookup = rs.Fields(0).Value
End If

Question 4

I almost never use DAO, so I’ll focus on the following…

Style

The block comment should really go above the Function declaration by convention. Placing it inside the procedure itself just adds a bunch of vertical space between the signature and the code, which is somewhat distracting. The convention is kind of important if you expect somebody else to be looking at your code, because it is more obvious what the point of the comment block is. Also, you can remove the 'This comment line is here to fix the formatting messing up. comment – it serves no real purpose in explaining the code, and AFAICT doesn’t effect the formatting at all.
Give your variables meaningful names. This is even more important when you have them jammed up in a declaration block at the top of the procedure. This includes loop counters, especially if meaning vis-a-vis what they are indexing. Something like rowIndex and columnIndex would be much more appropriate here than i and j, and u is just gratuitous – it should be something like parameterCount. Don’t make the person reading your code figure out what they’re supposed to mean.
Holy side-scrolling, Batman! VBA has line continuations for this very reason. Use them. My display is pretty wide, but I have docked windows that I need to navigate…
Get rid of the superfluous parentheses such as in expressions like And Not (IsNull(argParameters)). If you’re putting them there because the operator precedence isn’t obvious, you should probably split up and/or simplify the expressions – that’s a warning flag that your expression is a little too byzantine. In the cases where they are used in this function, however, they are pretty obvious. Note that they also force a ByVal context, so they aren’t completely innocuous.

Code Issues

Using a return value of Null for “no results” is convention breaking and potentially problematic for queries where Null is the actual result found. The uninitialized value of a Variant is Empty, and that is completely unambiguous to the caller. If you use that convention, you also don’t have to initialize the default return value with Qlookup = Null. You can just not set it. Then instead of the IsNull tests that I presume I’d find in the caller, you can use IsEmpty:
```
Public Sub Foo()
    Debug.Print IsEmpty(Bar)    '<-- True
End Sub

Public Function Bar() As Variant
End Function
```
Similarly, you shouldn’t use the default value of Null for your optional argParameters parameter, because Null has a different meaning. It’s a Variant, so you should be using IsMissing(argParameters) to determine if it was supplied as an argument. Note that argParameters should be declared ByVal – it is never assigned to, and if it was, it shouldn’t be.
Still on the parameter list, Optional ByVal argIsFilterString As Boolean = False is completely superfluous – non-Variant optional arguments are passed as their default value if they are not supplied. Optional ByVal argIsFilterString As Boolean is an identical signature. The function should look like this – everything else is just noise:
```
Public Function Qlookup(ByVal argQuery As String, _ 
                        Optional ByRef argParameters As Variant, _
                        Optional ByVal argIsFilterString As Boolean) As Variant
```
Cache repeatedly used values. For example, there is no code path on which qry.Parameters.Count is not used and several where you repeatedly get its value. Another place would be rs.Fields.Count, which is repeated called when it should be deterministically impossible for it to return a different value.
Related to the above, you are repeatedly subtracting one from rs.Fields.Count to get the bounding normalized to base zero. Just do that calculation once, and call it something like recordBound. If you get in the habit of doing that, you’ll find that it dramatically decreases the number of off-by-one errors you make.
Dereferencing isn’t free – you should be using With blocks if you’re repeatedly using the same object reference. The rs object would be a perfect candidate.
vbObjectError is intended to be added to a specific user-defined error constant, not used by itself like it is here:
```
Err.Raise vbObjectError, "Qlookup" '...
```
Raising vbObjectError without adding a constant is somewhat analogous to “Unknown user error”. Don’t rely on the description string to convey information about the error, especially if you’re building it dynamically – that part is for the user. If you ever need to test for a specific error that you’re raising, you’ll be kind of screwed – the error number exists for that purpose. Take advantage of it.
You have a potential bug with If IsArray(argParameters) Then. argParameters is a Variant, so it’s possible that you will be passed an uninitialized array. If the intent is that would throw, you nailed it. Since you are checking for other configuration issues explicitly, I’d test for that one too. Note that after the discussion on your previous question, I posted an answer over on SO with an implementation to check if an array is initialized.

Organization

This function does two very distinct things. Everything above If rs.RecordCount Then is “arranging” the Recordset for what comes below it. I’d extract that part into its own private function, and then simply call that if the public interface to it results in a correctly configured query. Instead of working with a single procedure that is ~80 lines long, you’ll be looking at one that is ~40 lines long and that is a Good Thing™. This will make it a lot simpler to debug, because you can concentrate on the thing that is failing. It also makes it a lot clearer what each function is doing to the reader.

To be honest, I’d probably implement functionality like this as some sort of QueryRunner class, and pass it an IQuerySetup to configure it. If you write a common IQueryRunner interface, you can split a lot of this up into concrete implementations that would make the code much, much more manageable and allow for some more unit testing (at least of the setup part).

Style

Code Issues

Organization

Leave a Reply Cancel reply