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
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:
RecordCountis not the most idiomatic way of checking for an empty.
EOFis 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.
MoveLastin order to get a count. You already know that
RecordCountdoesn’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:
GetRows method to extract an array out of recordset.
2) Use either a
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!
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”1 in your programming.
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
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.
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
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
I almost never use DAO, so I’ll focus on the following…
- The block comment should really go above the
Functiondeclaration 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
columnIndexwould be much more appropriate here than
uis 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
ByValcontext, so they aren’t completely innocuous.
Using a return value of
Nullfor “no results” is convention breaking and potentially problematic for queries where
Nullis the actual result found. The uninitialized value of a
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
IsNulltests that I presume I’d find in the caller, you can use
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
Nullfor your optional
Nullhas 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
argParametersshould 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 = Falseis completely superfluous – non-
Variantoptional arguments are passed as their default value if they are not supplied.
Optional ByVal argIsFilterString As Booleanis 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.Countis 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.Countto 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
Withblocks if you’re repeatedly using the same object reference. The
rsobject would be a perfect candidate.
vbObjectErroris intended to be added to a specific user-defined error constant, not used by itself like it is here:
Err.Raise vbObjectError, "Qlookup" '...
vbObjectErrorwithout 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.
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.
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).