Report Update Issues (1 Viewer)

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

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

      person = DLookup("ResponsiblePerson", "ToDoItemsTable", "ID = " & scratchTableRs!ToDoItemNumber)
      If IsNull(person) Then
         personAsNum = 12  'Unassigned person
      Else
         personAsNum = person
         End If
      pendingProjectItemsRs!ResponsiblePerson = person