This is a copy of a post I made on access-programmers.co.uk a few days ago, where there has been no solution. The issue is that I have a button that executes VBA code to pull together data and then report it, but the report doesn't always update to the current data.
The db is split, with the back end being on the network. A button on an unbound form starts everything off. It calls the code to update the back end data, then display the report.
If many things have changed, and the button is clicked, when everything is done the report will usually have invalid data. If the button is reclicked in a few seconds, and everything is reran, the report will then almost always be correct.
This seems to indicate that the cause is the current database state on each local machine isn't being updated to the back end state in a timely manner.
There is also a slight chance this has to do with having used lookup fields in the back end. I am in the process of removing them.
To give an idea of the work that is required, the following are two snippets from the VBA:
Code:
Private Sub CompileAllOpenItemsAgainstProjects_Click()
Dim response As Integer
response = MsgBox("Update the BOM master?", vbYesNo)
If (response = vbYes) Then
CreateBillOfMaterialsButton_Click
End If
'This will:
' 1 - clear the master PendingProjectItems_Compiled table
' 2 - go through the ToDo items for each BOM item, place them into the ToDoItemsScratchTable,
' and then transfer them to the PendingProjectItems_Compiled table. That table uses texts
' instead of numbers for some things, so it can compile different types of objects,
' such as tooling and ECNs.
SetStatusBarMsg "Working"
'Clear the PendingProjectItems_Compiled table:
DoCmd.SetWarnings False
'The following table is a compiled table - it is recompiled, derived data, not new data.
DeleteItemsFromTable "PendingProjectItemsTable_Compiled"
DoCmd.SetWarnings True
'ChangeAutoNumberTo 1, 1, "PendingProjectItemsTable_Compiled", False
'Before we do anything, we need to update the ECN locations:
FindNewestEcnLocationsA (False)
CompileToDoItems
CompileOpenEcnsAgainstRouterItems
CompileOpenEcnsAgainstBomItems
CompileToDosAgainstRouterItems
'CompileToolLocations
CopyToLocalTable 'In order to get around back end locking problem
SetStatusBarMsg "Working ... Finished"
If Me.Dirty Then Me.Dirty = False
DoCmd.OpenReport "PendingProjectItemsReport", acViewReport
theEnd:
End Sub
The code for dealing with the To Do Items is indicative of the rest of the logic.The report data is based off the PendingProjectItemsTable_Compiled table.
Code:
Private Function CompileToDoItems()
On Error GoTo ErrorProc
'This is called by the CompileAllOpenItemsAgainstProjects_Click event to do as the name implies
'First, we will go through the master BOM and look at each item and see if there
'are any 'ToDo' items against them. We will place them in a scratch table:
'Clear the scratch table:
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * From ToDoItemsScratchTable"
DoCmd.SetWarnings True
ChangeAutoNumberTo 1, 1, "ToDoItemsScratchTable", False
'Open up the 'BomsTable_Created', so we can see if there is anything against the BOM items:
Dim db As Database
Set db = CurrentDb
Dim bomItems As Recordset
Set bomItems = db.OpenRecordset("Select * from BomsTable_Created")
Dim scratchTableRs As Recordset
Set scratchTableRs = db.OpenRecordset("Select * from ToDoItemsScratchTable")
Dim toDoItemsRs As Recordset
Do Until bomItems.EOF
Set toDoItemsRs = db.OpenRecordset("Select * from ToDoItemsTable Where Item = " & bomItems!Component)
Do Until toDoItemsRs.EOF
If toDoItemsRs!PercentDone <> 100 Then
scratchTableRs.AddNew
scratchTableRs!Component = bomItems!Component
scratchTableRs!Assembly = bomItems!Assembly
scratchTableRs!ToDoItemNumber = toDoItemsRs!ID
scratchTableRs.Update
End If
toDoItemsRs.MoveNext
Loop
bomItems.MoveNext
toDoItemsRs.Close
Loop
Set toDoItemsRs = Nothing
'Now copy the scratchTableRs into the PendingProjectItems_Compiled table:
scratchTableRs.MoveFirst
Dim pendingProjectItemsRs As Recordset 'This has been cleared in the CompileAllOpenItemsAgainstProjects_Click
Set pendingProjectItemsRs = db.OpenRecordset("Select * from PendingProjectItemsTable_Compiled")
Dim toDoQueryRs As Recordset
Set toDoQueryRs = db.OpenRecordset("Select * from ToDoItemsScratchTable")
Dim person As Variant
Dim personAsNum As Long
Dim personAsStr As String
Dim Assembly As Long
Dim atcoID As String
Dim atcoSubID As Variant
Do Until toDoQueryRs.EOF
pendingProjectItemsRs.AddNew
Assembly = scratchTableRs!Assembly
pendingProjectItemsRs!Assembly = Assembly
pendingProjectItemsRs!AssemblyAsText = DLookup("Number", "ItemsTable", "ID = " & Assembly)
atcoID = DLookup("AtcoID", "AssembliesTable", "Item = " & Assembly)
pendingProjectItemsRs!AtcoMainID = atcoID
atcoSubID = DLookup("AtcoSubID", "AssembliesTable", "Item = " & Assembly)
If Not IsNull(atcoSubID) Then
atcoID = atcoID & " - " & atcoSubID
pendingProjectItemsRs!atcoSubID = atcoSubID
End If
pendingProjectItemsRs!AtcoFullID = atcoID
pendingProjectItemsRs!Component = scratchTableRs!Component
pendingProjectItemsRs!ComponentNumber = DLookup("Number", "ItemsTable", "ID = " & scratchTableRs!Component)
pendingProjectItemsRs!Item = "TODO: " & DLookup("ToDoItem", "ToDoItemsTable", "ID = " & scratchTableRs!ToDoItemNumber)
person = DLookup("ResponsiblePerson", "ToDoItemsTable", "ID = " & scratchTableRs!ToDoItemNumber)
If IsNull(person) Then
personAsNum = 12 'Unassigned person
Else
personAsNum = person
End If
pendingProjectItemsRs!ResponsiblePerson = person
personAsStr = DLookup("FirstName", "PeopleTable", "ID = " & personAsNum) & " " & DLookup("LastName", "PeopleTable", "ID = " & personAsNum)
pendingProjectItemsRs!ResponsiblePersonsName = personAsStr
pendingProjectItemsRs!Note = Format(DLookup("DateDue", "ToDoItemsTable", "ID = " & scratchTableRs!ToDoItemNumber), "mm/dd") & " " & _
DLookup("Notes", "ToDoItemsTable", "ID = " & scratchTableRs!ToDoItemNumber)
pendingProjectItemsRs.Update
scratchTableRs.MoveNext
toDoQueryRs.MoveNext
Loop
toDoQueryRs.Close
Set toDoQueryRs = Nothing
pendingProjectItemsRs.Close
Set pendingProjectItemsRs = Nothing
scratchTableRs.Close
Set scratchTableRs = Nothing
bomItems.Close
Set bomItems = Nothing
Set db = Nothing
ExitProc:
Exit Function
ErrorProc: 'Simple for now, but could be improved
MsgBox ("Error occurred compiling To Do Items")
End Function
If you have any suggestions, please holler!
Thanks,
David