Access VBA function While...Wend or Do ...Loop - ms-access

Question

I am working on a function for my access database that fills in a form field in my task form automatically based on the data entered in products forms.
Function IsProductReceived(varID As Variant) As String
Dim rst As New ADODB.Recordset
Dim strSQL As String
Dim lngTOID As Long
Dim strReceiveDate As Date
Dim bAcceptable As Boolean
On Error GoTo ErrorHandler
If IsNull(varID) Then
IsProductReceived = "TBD"
Else
lngTOID = varID
strSQL = "SELECT tblProduct.TaskID, tblProduct.Received, tblProduct.Acceptable FROM tblProduct WHERE tblProduct.TaskID = " & lngTOID
rst.Open strSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
If rst.BOF And rst.EOF Then
IsProductReceived = "TBD"
Exit Function
Else
While rst.EOF = False
If rst![Received] <> "" Then
strReceiveDate = rst![Received]
bAcceptable = rst![Acceptable]
If IsDate(strReceiveDate) Then
If bAcceptable = False Then
IsProductReceived = "YES/NOT ACCEPTED"
Else
IsProductReceived = "YES/ACCEPTED"
End If
Else
IsProductReceived = "NO"
End If
Else
IsProductReceived = "NO"
End If
rst.MoveNext
Wend
End If
rst.Close
Set rst = Nothing
End If
Exit Function
ErrorHandler:
MsgBox Err.Description
Err.Clear
If rst.State = adStateOpen Then
rst.Close
Set rst = Nothing
End If
End Function
There is often more that one product forms related to the task form and products are received at different times. I want the "IsProductReceived = "no" to remain on the task form until ALL products related to the task are received.
This code seems to be working as long as the first product has not been received. I can seem to figure out how to make it remain "no" until all products are received.
I currently am using a while/wend, I have attempted a Do/loop but am still not having satisfactory results. Any help would be much appreciated

Answer 1

How about:
Function IsProductReceived(TaskID) As String
Dim product As New ADODB.Recordset
Dim sql As String
Dim countAll As Integer
Dim countReceived As Integer
Dim countAccepted As Integer
IsProductReceived = "TBD"
If Not IsNumeric(TaskID) Then Exit Function
sql = "SELECT Received, Acceptable FROM tblProduct WHERE TaskID = " & TaskID
product.Open sql, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
While Not product.EOF
countAll = countAll + 1
If IsDate(product!Received) Then countReceived = countReceived + 1
If product!Acceptable Then countAccepted = countAccepted + 1
product.MoveNext
Wend
product.Close
If countAll = 0 Then
IsProductReceived = "No"
ElseIf countAll = countAccepted Then
IsProductReceived = "YES/ACCEPTED"
ElseIf countAll = countReceived Then
IsProductReceived = "YES/NOT ACCEPTED"
Else
IsProductReceived = "No"
End If
End Function
A few notes:
Indent your code better.
Drop the faux Hungarian notation, use descriptive variable names.
Avoid deep nesting, especially when it comes to determining the return value.
Check parameters and exit early if the check fails. This removes nesting depth from the function.
Avoid Variant parameter types unless the function must deal with different data types. Here an Integer or Long type would probably be a better fit. (Using a typed function parameter removes the need for a type check entirely.)
While x = False is an antipattern. Use While Not x.
No need to save recordset fields in local variables first. Just use them directly.
Avoid building SQL from string concatenation. After an IsNumeric() check the above is probably okay, but you really should use parameterized queries.

Answer 2

The issue I'm seeing with your code is that you're getting a record set from a table, looping through the set and testing "Recieved" and then assigning a return value for your function after each test. Effectively, you're just returning the value of the very last record in the recordset. Perhaps instead of setting the value of isProductRecieved inside the While loop, set a bool value to false whenever you encounter a product that hasn't been recieved and then set the return value of the function after the loop:
Dim receive As Boolean
Dim accept As Boolean
receive = True
accept = False
If rst![Received] <> "" Then
strReceiveDate = rst![Received]
bAcceptable = rst![Acceptable]
If IsDate(strReceiveDate) Then
If bAcceptable = False Then
accept = False
Else
accept = True
End If
Else
receive = False
End If
Else
receive = False
End If
So now, if "receive" makes it all the way to the end of your while loop, you know that each product is received but if any product was not received it would be set to false. You could also build a short circuit in there to make it a tiny bit faster.