Exodus
Registered User.
- Local time
- Today, 02:49
- Joined
- Dec 4, 2003
- Messages
- 317
I am on Access 2016 64bit.
My VBA is not great but I manage. The code I am working with was done by someone else that is no longer available.
I am having issues with one of my list boxes. I am not sure but it seems as though it is retaining the previous selection in memory and its inconsistent.
This db helps tracks the work flow on batches through their various stages. As a batch moves from one stage to the next it goes from one list box to the next. Part of this process is to run reports filtered by the list boxes selection. As each part of the flow is completed the list boxes are re-queried.
Every now and then this particular list box and maybe others but haven't ran into it yet with the others, still seems to have its selection in memory.
The code does test if there are any items selected, but that is where the problem is. It is passing the test even though there are no selections.
I have tried manually selecting and selecting an remaining items but it still persist. Have tried to clear selections with code as well, re-querying. I am at a loss. Its weird because it seems like its a mix of the current selections and the old because another part of the code errors out due to a null value. Forgot to mention the only thing that clears the error is closing the form and reopening it.
Sorry for rambling I am just trying to explain it all.
Here is the initial calling code that passes the selection count
Here is the code that fails because null values, its the red selection
My VBA is not great but I manage. The code I am working with was done by someone else that is no longer available.
I am having issues with one of my list boxes. I am not sure but it seems as though it is retaining the previous selection in memory and its inconsistent.
This db helps tracks the work flow on batches through their various stages. As a batch moves from one stage to the next it goes from one list box to the next. Part of this process is to run reports filtered by the list boxes selection. As each part of the flow is completed the list boxes are re-queried.
Every now and then this particular list box and maybe others but haven't ran into it yet with the others, still seems to have its selection in memory.
The code does test if there are any items selected, but that is where the problem is. It is passing the test even though there are no selections.
I have tried manually selecting and selecting an remaining items but it still persist. Have tried to clear selections with code as well, re-querying. I am at a loss. Its weird because it seems like its a mix of the current selections and the old because another part of the code errors out due to a null value. Forgot to mention the only thing that clears the error is closing the form and reopening it.
Sorry for rambling I am just trying to explain it all.
Here is the initial calling code that passes the selection count
Code:
Private Sub cmdWorkflowSortPassReport_Click()
Dim varParams(1, 4) As Variant
varParams(0, 0) = "UploadedtoDims": varParams(1, 0) = "True"
varParams(0, 1) = "SigCheckComplete": varParams(1, 1) = "True"
varParams(0, 2) = "DispositionCreated": varParams(1, 2) = "True"
varParams(0, 3) = "SortPassCompleted": varParams(1, 3) = "False"
varParams(0, 4) = "BatchAuditCompleted": varParams(1, 4) = "False"
If IsNull(Me.AlphaAssign) Then
MsgBox "Please Select a LetterAssignment"
ClearList Me.lstReadyForSortPass
Exit Sub
End If
If Me.lstReadyForSortPass.ItemsSelected.Count = 0 Then
MsgBox "Error, must select at least one batch", vbOKOnly + vbInformation, "Error, Select at least one batch"
Else
OpenReportFiltered , "QryBatchManagementListBoxSortPass", "Ready for Sort Pass Report", "lstReadyForSortPass", varParams
Me.AlphaAssign.Requery
Me.UsedAlphas.Requery
RequeryListBoxes
Me.AlphaAssign = Null
End If
End Sub
Here is the code that fails because null values, its the red selection
Code:
Private Sub OpenReportFiltered(Optional strReportName As String = "RptBatchManagement", _
Optional strQueryName As String = "QryBatchManagement", Optional strReportTitle As String = "Batch Management Report", _
Optional strListBoxName As String = "", Optional varParams As Variant = Null)
Dim LResponse As Long
Dim db As Dao.Database: Set db = CurrentDb()
Dim qdf As QueryDef: Set qdf = db.QueryDefs(strQueryName)
Dim qdfnew As Dao.QueryDef
If strQueryName = "QryBatchManagementChallenged" Then
Set qdfnew = db.QueryDefs(strQueryName & "Filtered")
Else
Set qdfnew = db.QueryDefs(strQueryName)
End If
Dim rst As Dao.Recordset, rstsub As Dao.Recordset
Dim strOrigSQL As String: strOrigSQL = qdf.Sql: qdfnew.Sql = qdf.Sql
Dim ctl As Control
Dim strSQLLeft As String, strSQLRight As String, strSQL As String
Dim iCharPos As Integer, i As Integer, j As Integer
Dim strVariable As String, strParameter As String
Dim bBatchAuditReport As Integer
Dim strLeft As String, strRight As String, strItem As String, strItems As String
Dim lBatchNumber As Long
Dim prm As Dao.Parameter
If strReportName = "RptBatchAudit" Or strReportName = "RptBatchAuditByBatch" Then bBatchAuditReport = True
If Not IsNull(strListBoxName) Then
Set ctl = Me.Controls(strListBoxName)
Else
Set ctl = Nothing
End If
Dim varItemSelected As Variant
Dim strItemSelected As String
iCharPos = InStr(qdf.Sql, "WHERE ")
If iCharPos > 0 Then
'strSQLLeft is SELECT * FROM ...
'strSQLRight is WHERE ...
strSQLLeft = Left(qdf.Sql, iCharPos - 1)
strSQLRight = Right(qdf.Sql, Len(qdf.Sql) - iCharPos + 1 - Len("WHERE "))
strSQL = strSQLLeft
End If
If strListBoxName <> "subQualityControl" Then
If ctl.ListCount = 0 Then
MsgBox "Nothing to Report", vbOKOnly + vbInformation, "Nothing to Report"
Exit Sub
End If
strSQL = strSQL & "WHERE "
If ctl.ItemsSelected.Count > 0 Then
If bBatchAuditReport Then
strSQL = strSQL & "Batch IN ("
Else
strSQL = strSQL & "BatchNumber IN ("
End If
For Each varItemSelected In ctl.ItemsSelected
[COLOR="Red"] strItemSelected = ctl.ItemData(varItemSelected)[/COLOR]
If strItemSelected <> "" Then
If strListBoxName = "lstChallenged" Then
iCharPos = InStr(1, strItemSelected, " ")
If iCharPos <> 0 Then
strItem = Left(strItemSelected, iCharPos - 1)
Else
strItem = strItemSelected
End If
Else
strItem = strItemSelected
End If
strItems = strItem & ", "
strSQL = strSQL & strItem & ", "
iCharPos = 0
End If
Next varItemSelected
strItems = Left(strItems, Len(strItems) - 2)
strSQL = Left(strSQL, Len(strSQL) - 2)
strSQL = strSQL & ") AND "
End If
Else
Set rstsub = Me.subQualityControl.Form.Recordset
lBatchNumber = rstsub!BatchNumber
strSQL = strSQL & "WHERE BatchNumber=" & lBatchNumber & " AND "
End If
If Not IsNull(varParams) Then
If UBound(varParams) > 0 Then
j = UBound(varParams, 1)
If j <> 1 Then
Debug.Print "Expected 2 Params, got " & j
End If
If Not bBatchAuditReport Then strSQL = strSQL & "[BatchType] = ""VALID"" AND "
For i = 0 To UBound(varParams, 2)
strVariable = varParams(0, i)
strParameter = varParams(1, i)
'Debug.Print strVariable & " = " & strParameter
strSQL = strSQL & "[" & strVariable & "] = " & strParameter & " AND "
Next i
If bBatchAuditReport Then
strSQL = strSQL & "[election_id] = [TempVars]![EID]"
Else
strSQL = strSQL & "[ElectionID] = [TempVars]![EID]"
End If
End If
Else
If Not bBatchAuditReport Then
strSQL = strSQL & "[BatchType] = ""VALID"""
Else
strSQL = Left(strSQL, Len(strSQL) - Len(" AND"))
End If
End If
'Debug.Print qdf.sql
qdfnew.Sql = qdf.Sql
qdfnew.Sql = strSQL
If strReportName = "RptQualityControl" Then
For Each prm In qdfnew.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdfnew.OpenRecordset(dbOpenDynaset)
With rst
.MoveLast
.MoveFirst
If .RecordCount > 1 Then
MsgBox "Error, Please select only one Batch for Quality Control"
GoTo ExitMe
End If
Do Until .EOF
If !QualityControlReportGenerated Then
LResponse = MsgBox("Error, Quality Control Report already generated for batch " & !BatchNumber & " At " & CStr(!QualityControlReportGeneratedDate) & vbCrLf & "Generate Report again?", vbCritical + vbYesNo, "Error, Quality Control Report already generated")
If LResponse = vbNo Then
GoTo ExitMe
End If
End If
.MoveNext
Loop
.MoveFirst
.Edit
!QualityControlReportGenerated = True
!QualityControlReportGeneratedDate = Now()
.Update
End With
Set rst = Nothing
End If
'Debug.Print strSQL
Debug.Print Me.AlphaAssign
If strListBoxName = "lstReadyForSortPass" Then
If IsNull(Me.AlphaAssign) Then
MsgBox "Please Select a LetterAssignment"
GoTo ExitMe
End If
DoCmd.SetWarnings False
DoCmd.OpenQuery "QryUpdateBatchAuditAlphaAssignment"
DoCmd.OpenQuery "QryUpdateSortPassQue"
DoCmd.SetWarnings True
End If
DoCmd.OpenReport ReportName:=strReportName, View:=acViewPreview, OpenArgs:=qdfnew.Name & "," & strReportTitle
ExitMe:
qdfnew.Sql = strOrigSQL
Set rst = Nothing
Set qdf = Nothing
Set qdfnew = Nothing
Set rstsub = Nothing
End Sub
Last edited: