208 lines
6.5 KiB
Markdown
208 lines
6.5 KiB
Markdown
# Sorted by Machine
|
|
Analysis generated on: 4/1/2025 4:07:22 PM
|
|
---
|
|
## Record Source
|
|
- *None*
|
|
## Controls
|
|
| Control Name | Reference |
|
|
|--------------|-----------|
|
|
| Machine Name (Row Source) | [[Tables/[MachineNames];]] |
|
|
## VBA Code
|
|
```vba
|
|
Private Sub Command2_Click()
|
|
Dim MainDB As Database, MainSet As Recordset
|
|
Dim MainDB2 As Database, MainSet2 As Recordset
|
|
|
|
Set MainDB = DBEngine.Workspaces(0).Databases(0)
|
|
Set MainDB2 = DBEngine.Workspaces(0).Databases(0)
|
|
Command2.Tag = Command2.Caption
|
|
Command2.Caption = "Processing"
|
|
Edit_Table.Enabled = False
|
|
|
|
' DoEvents
|
|
' lblstatus.Caption = "Selecting Parts for Material Utilization"
|
|
'DoCmd.RunMacro "Material Selections for Utilitzation"
|
|
'lblstatus.Caption = "Selection Complete"
|
|
Refresh
|
|
lblstatus.Caption = "Moving Parts to AS400"
|
|
Set MainSet = MainDB.OpenRecordset("RMSFILES#_IEMUP1A0") ' Create dynaset.
|
|
Set MainSet2 = MainDB2.OpenRecordset("Sorted By Machines 1") ' Create dynaset.
|
|
|
|
lblstatus.Caption = "Purging AS400 product number file"
|
|
On Error Resume Next
|
|
MainSet.MoveFirst
|
|
On Error GoTo 0
|
|
|
|
Do
|
|
If Not (MainSet.EOF) Then
|
|
MainSet.Delete
|
|
DoEvents
|
|
Else
|
|
DoEvents
|
|
Exit Do
|
|
End If
|
|
MainSet.MoveNext
|
|
Loop
|
|
|
|
lblstatus.Caption = "Purging AS400 result file"
|
|
MainSet2.MoveFirst
|
|
Do
|
|
If Not (MainSet2.EOF) Then
|
|
p$ = MainSet2!prt
|
|
MainSet.AddNew
|
|
MainSet!PRDNO = p$
|
|
MainSet.Update
|
|
DoEvents
|
|
Else
|
|
DoEvents
|
|
Exit Do
|
|
End If
|
|
MainSet2.MoveNext
|
|
Loop
|
|
|
|
lblstatus.Caption = "Activating AS400 Program"
|
|
DoEvents
|
|
ActiveXCtl24.DoClick
|
|
|
|
lblstatus.Caption = "Retrieving Results"
|
|
UtilResult2.SourceObject = "tricks"
|
|
DoCmd.RunMacro "AS400 Utiliz Results for steve"
|
|
UtilResult2.SourceObject = "Util Result2"
|
|
lblstatus.Caption = "Calculating material utilization on parts"
|
|
lblstatus.Caption = "Done"
|
|
Command2.Caption = Command2.Tag
|
|
Edit_Table.Enabled = True
|
|
|
|
End Sub
|
|
|
|
Private Sub Machine_Name_BeforeUpdate(Cancel As Integer)
|
|
Command2.Enabled = False
|
|
DoCmd.SetWarnings (False)
|
|
|
|
DoCmd.OpenQuery "Sort by Machine"
|
|
DoCmd.SetWarnings (True)
|
|
Command2.Enabled = True
|
|
End Sub
|
|
Private Sub Edit_Table_Click()
|
|
On Error GoTo Err_Edit_Table_Click
|
|
|
|
Dim stDocName As String
|
|
Dim MyForm As Form
|
|
|
|
stDocName = "Util Selection C1"
|
|
Set MyForm = Screen.ActiveForm
|
|
|
|
DoCmd.OpenTable stDocName, acViewNormal
|
|
|
|
Exit_Edit_Table_Click:
|
|
Exit Sub
|
|
|
|
Err_Edit_Table_Click:
|
|
MsgBox Err.Description
|
|
Resume Exit_Edit_Table_Click
|
|
|
|
End Sub
|
|
|
|
Private Sub Refresh_Click()
|
|
UtilResult2.SourceObject = "tricks"
|
|
UtilResult2.SourceObject = "Util Result2"
|
|
|
|
End Sub
|
|
```
|
|
## What it does
|
|
**Command2_Click Subroutine**
|
|
==========================
|
|
|
|
This subroutine is triggered when the Command2 button is clicked. It performs a series of operations related to material utilization and AS400 integration.
|
|
|
|
### Initialization
|
|
|
|
* Retrieves the first database (`MainDB`) and second database (`MainDB2`) from the list in the current workspace.
|
|
* Sets the `Tag` property of the Command2 button to its current caption and changes it to "Processing".
|
|
* Disables the Edit Table control to prevent any accidental modifications during the processing.
|
|
* Calls the `Refresh` subroutine to update the UI.
|
|
|
|
### Material Utilization Processing
|
|
|
|
* Retrieves two Recordsets (`MainSet` and `MainSet2`) from the first database, which contain data for material utilization and AS400-related information, respectively.
|
|
* Purges the AS400 product number file by deleting all records in the `Sorted By Machines 1` Recordset. This is done using a loop that moves through each record, deletes it if it's not at the end of the Recordset, and then continues to the next record.
|
|
* Inserts new records into the `PRDNO` field of the `MainSet` Recordset based on the product number in the AS400 file. This is done using a loop that moves through each record in the `Sorted By Machines 1` Recordset, extracts the product number, adds it to the `MainSet`, and then updates the Recordset.
|
|
|
|
### AS400 Program Activation
|
|
|
|
* Disables any warnings in the database for the next 10 seconds.
|
|
* Opens a query called "Sort by Machine" using `DoCmd.OpenQuery`.
|
|
* Enables the Command2 button again after the warning period has expired.
|
|
|
|
### Result Retrieval and Calculation
|
|
|
|
* Updates the source object of the `UtilResult2` control to "tricks".
|
|
* Runs a macro called "AS400 Utiliz Results for steve" to retrieve results from AS400.
|
|
* Updates the source object of the `UtilResult2` control to "Util Result2".
|
|
|
|
### Finalization
|
|
|
|
* Changes the caption of the Command2 button back to its original value and re-enables the Edit Table control.
|
|
|
|
**Machine_Name_BeforeUpdate Subroutine**
|
|
=====================================
|
|
|
|
This subroutine is triggered when the user attempts to update the Machine Name in the Sort by Machine query. It ensures that the Command2 button remains disabled until the warning period has expired after opening the query.
|
|
|
|
### Code Snippet:
|
|
|
|
```vba
|
|
Private Sub Machine_Name_BeforeUpdate(Cancel As Integer)
|
|
Command2.Enabled = False
|
|
DoCmd.SetWarnings (False)
|
|
|
|
DoCmd.OpenQuery "Sort by Machine"
|
|
DoCmd.SetWarnings (True)
|
|
Command2.Enabled = True
|
|
End Sub
|
|
```
|
|
|
|
**Edit_Table_Click Subroutine**
|
|
=============================
|
|
|
|
This subroutine is triggered when the Edit Table button is clicked. It handles any errors that occur during editing and provides a user-friendly message to the user.
|
|
|
|
### Code Snippet:
|
|
|
|
```vba
|
|
Private Sub Edit_Table_Click()
|
|
On Error GoTo Err_Edit_Table_Click
|
|
|
|
Dim stDocName As String
|
|
Dim MyForm As Form
|
|
|
|
stDocName = "Util Selection C1"
|
|
Set MyForm = Screen.ActiveForm
|
|
|
|
Exit_Edit_Table_Click:
|
|
Exit Sub
|
|
|
|
Err_Edit_Table_Click:
|
|
MsgBox Err.Description
|
|
Resume Exit_Edit_Table_click
|
|
|
|
End Sub
|
|
```
|
|
|
|
**Refresh_Click Subroutine**
|
|
=========================
|
|
|
|
This subroutine is triggered when the Refresh button is clicked. It updates the source object of the `UtilResult2` control to both "tricks" and "Util Result2".
|
|
|
|
### Code Snippet:
|
|
|
|
```vba
|
|
Private Sub Refresh_Click()
|
|
UtilResult2.SourceObject = "tricks"
|
|
UtilResult2.SourceObject = "Util Result2"
|
|
|
|
End Sub
|
|
```
|
|
|
|
In summary, this code provides a comprehensive workflow for material utilization processing, including data retrieval from databases, integration with AS400, and result calculation. The subroutines handle user interactions, errors, and UI updates to provide a seamless experience.
|