385 lines
9.3 KiB
Markdown
385 lines
9.3 KiB
Markdown
# Material Upgrade
|
|
Analysis generated on: 4/1/2025 4:07:02 PM
|
|
---
|
|
## Record Source
|
|
- [[Queries/Processes by material]]
|
|
## Controls
|
|
| Control Name | Reference |
|
|
|--------------|-----------|
|
|
| *None* | - |
|
|
## VBA Code
|
|
```vba
|
|
Option Compare Database
|
|
|
|
|
|
|
|
|
|
Private Sub Command13_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)
|
|
lblstatus.Caption = "Setting up Database"
|
|
|
|
Dim stDocName As String
|
|
Command16.Enabled = False
|
|
|
|
stDocName = "Processes by material 2"
|
|
DoCmd.OpenQuery stDocName, acNormal, acEdit
|
|
|
|
|
|
lblstatus.Caption = "Moving Parts to AS400"
|
|
|
|
Set MainSet = MainDB.OpenRecordset("RMSFILES#_IEMUP1A0") ' Create dynaset.
|
|
Set MainSet2 = MainDB2.OpenRecordset("Process by material") ' 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
|
|
|
|
'"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
|
|
|
|
|
|
|
|
stDocName = "Processes by material 2d"
|
|
DoCmd.OpenQuery stDocName, acNormal, acEdit
|
|
|
|
|
|
lblstatus.Caption = "Done"
|
|
DoCmd.OpenTable "Process by material 2"
|
|
Exit_Command13_Click:
|
|
Command16.Enabled = True
|
|
Exit Sub
|
|
|
|
Err_Command13_Click:
|
|
MsgBox Err.Description
|
|
Resume Exit_Command13_Click
|
|
End Sub
|
|
|
|
Private Sub Command16_Click()
|
|
On Error GoTo Err_Command16_Click
|
|
|
|
Dim stDocName As String
|
|
Dim stLinkCriteria As String
|
|
|
|
stDocName = "14" + Chr$(34) + " Process Sheet"
|
|
DoCmd.OpenForm stDocName
|
|
Forms![14" Process Sheet].recordSource = "Processes by material 4"
|
|
DoCmd.Close acForm, "Material Upgrade"
|
|
Exit_Command16_Click:
|
|
Exit Sub
|
|
|
|
Err_Command16_Click:
|
|
MsgBox Err.Description
|
|
Resume Exit_Command16_Click
|
|
|
|
|
|
End Sub
|
|
|
|
Private Sub Command2_Click()
|
|
On Error GoTo Err_Command2_Click
|
|
|
|
Dim stDocName As String
|
|
Command3.Enabled = False
|
|
stDocName = "Processes by material 2"
|
|
DoCmd.OpenQuery stDocName, acNormal, acEdit
|
|
Call Command4_Click
|
|
stDocName = "Processes by material 2a"
|
|
DoCmd.OpenQuery stDocName, acNormal, acEdit
|
|
DoCmd.OpenTable "Process by material"
|
|
Exit_Command2_Click:
|
|
Command3.Enabled = True
|
|
Exit Sub
|
|
|
|
Err_Command2_Click:
|
|
MsgBox Err.Description
|
|
Resume Exit_Command2_Click
|
|
|
|
End Sub
|
|
Private Sub Command3_Click()
|
|
On Error GoTo Err_Command3_Click
|
|
|
|
Dim stDocName As String
|
|
Dim stLinkCriteria As String
|
|
|
|
stDocName = "14" + Chr$(34) + " Process Sheet"
|
|
DoCmd.OpenForm stDocName
|
|
Forms![14" Process Sheet].recordSource = "Processes by material 3"
|
|
DoCmd.Close acForm, "Material Upgrade"
|
|
Exit_Command3_Click:
|
|
Exit Sub
|
|
|
|
Err_Command3_Click:
|
|
MsgBox Err.Description
|
|
Resume Exit_Command3_Click
|
|
|
|
End Sub
|
|
|
|
Private Sub Command4_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)
|
|
|
|
DoCmd.RunMacro "Material Selections for Utilitzation"
|
|
Refresh
|
|
|
|
' "Moving Parts to AS400"
|
|
|
|
Set MainSet = MainDB.OpenRecordset("RMSFILES#_IEMUP1A0") ' Create dynaset.
|
|
Set MainSet2 = MainDB2.OpenRecordset("Process by material") ' Create dynaset.
|
|
|
|
' "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
|
|
|
|
' "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
|
|
|
|
|
|
|
|
|
|
' "Retrieving Results"
|
|
|
|
' DoCmd.RunMacro "AS400 Utiliz Results"
|
|
' UtilResult1.SourceObject = "Util Result1"
|
|
' ' lblStatus.Caption = "Calculating material utilization on parts"
|
|
' lblstatus.Caption = "Done"
|
|
' Command133.Caption = Command133.Tag'
|
|
|
|
End Sub
|
|
```
|
|
## What it does
|
|
**VBA Code Overview**
|
|
=====================
|
|
|
|
This VBA code is designed to automate various tasks in Microsoft Access, specifically related to data manipulation and synchronization with an AS400 system. The code consists of four main subroutines: `Command13_Click`, `Command16_Click`, `Command2_Click`, and `Command3_Click`.
|
|
|
|
**`Command13_Click` Subroutine**
|
|
-------------------------------
|
|
|
|
### Purpose
|
|
|
|
This subroutine is triggered when a button labeled "Command 13" is clicked. Its primary function is to perform the following tasks:
|
|
|
|
1. **Open Queries**: Open two queries: "Processes by material 2" and "14 Process Sheet".
|
|
2. **Delete Data from RMSFILES#\_IEMUP1A0 Recordset**:
|
|
* Move to the first record in the "RMSFILES#\_IEMUP1A0" recordset.
|
|
* Delete each record in the recordset until it is empty.
|
|
|
|
3. **Add Product Numbers to Process by material Recordset**:
|
|
* Open the "Process by material" recordset and move to its first record.
|
|
* Iterate through each record, adding a product number from the RMSFILES#\_IEMUP1A0 recordset if it exists.
|
|
4. **Activate AS400 Program**: Activate an AS400 program.
|
|
|
|
### Code Structure
|
|
|
|
```markdown
|
|
Option Compare Database
|
|
|
|
' Initialize databases and recordsets
|
|
Dim MainDB As Database
|
|
Dim MainSet As Recordset
|
|
Dim MainDB2 As Database
|
|
Dim MainSet2 As Recordset
|
|
|
|
' Open queries
|
|
DoCmd.OpenQuery "Processes by material 2", acNormal, acEdit
|
|
DoCmd.OpenForm "14 Process Sheet"
|
|
Forms![14" Process Sheet"].recordSource = "Processes by material 4"
|
|
|
|
' Delete data from RMSFILES#\_IEMUP1A0 recordset
|
|
Set MainSet = MainDB.OpenRecordset("RMSFILES#_IEMUP1A0") ' Create dynaset
|
|
MainSet.MoveFirst
|
|
Do While Not MainSet.EOF
|
|
MainSet.Delete
|
|
DoEvents
|
|
MainSet.MoveNext
|
|
Loop
|
|
|
|
' Add product numbers to Process by material recordset
|
|
Set MainSet2 = MainDB2.OpenRecordset("Process by material") ' Create dynaset
|
|
MainSet2.MoveFirst
|
|
Do While Not MainSet2.EOF
|
|
p$ = MainSet2!prt
|
|
If Not IsNull(p$) Then
|
|
MainSet2.AddNew
|
|
MainSet2!PRDNO = p$
|
|
MainSet2.Update
|
|
DoEvents
|
|
End If
|
|
MainSet2.MoveNext
|
|
Loop
|
|
|
|
' Activate AS400 program
|
|
ActiveXCtl24.DoClick
|
|
|
|
' Open additional query
|
|
DoCmd.OpenQuery "Processes by material 2d"
|
|
DoCmd.OpenTable "Process by material 2"
|
|
|
|
Exit_Command13_Click:
|
|
Command16.Enabled = True
|
|
Exit Sub
|
|
|
|
Err_Command13_Click:
|
|
MsgBox Err.Description
|
|
Resume Exit_Command13_Click
|
|
```
|
|
|
|
**`Command16_Click` Subroutine**
|
|
------------------------------
|
|
|
|
### Purpose
|
|
|
|
This subroutine is triggered when a button labeled "Command 16" is clicked. Its primary function is to:
|
|
|
|
1. **Open Form**: Open the "14 Process Sheet" form.
|
|
|
|
2. **Refresh Form Data**: Refresh the record source of the "Process Sheet" form to "Processes by material 4".
|
|
|
|
3. **Close Form**: Close the "Material Upgrade" form.
|
|
|
|
### Code Structure
|
|
|
|
```markdown
|
|
Private Sub Command16_Click()
|
|
|
|
' Open form and refresh data
|
|
DoCmd.OpenForm "14 Process Sheet"
|
|
Forms![14" Process Sheet"].recordSource = "Processes by material 4"
|
|
|
|
Exit_Command16_Click:
|
|
Exit Sub
|
|
|
|
Err_Command16_Click:
|
|
MsgBox Err.Description
|
|
Resume Exit_Command16_Click
|
|
```
|
|
|
|
**`Command2_Click` Subroutine**
|
|
-----------------------------
|
|
|
|
### Purpose
|
|
|
|
This subroutine is triggered when a button labeled "Command 2" is clicked. Its primary function is to:
|
|
|
|
1. **Open Queries**: Open two queries: "Processes by material 2" and "Processes by material 2a".
|
|
|
|
2. **Call Command4_Click Subroutine**: Call the `Command4_Click` subroutine.
|
|
|
|
3. **Close Table**: Close the "Process by material" table.
|
|
|
|
### Code Structure
|
|
|
|
```markdown
|
|
Private Sub Command2_Click()
|
|
|
|
' Open queries
|
|
DoCmd.OpenQuery "Processes by material 2"
|
|
DoCmd.OpenQuery "Processes by material 2a"
|
|
|
|
Exit_Command2_Click:
|
|
Command3.Enabled = True
|
|
Exit Sub
|
|
|
|
Err_Command2_Click:
|
|
MsgBox Err.Description
|
|
Resume Exit_Command2_Click
|
|
```
|
|
|
|
**`Command3_Click` Subroutine**
|
|
-----------------------------
|
|
|
|
### Purpose
|
|
|
|
This subroutine is triggered when a button labeled "Command 3" is clicked. Its primary function is to:
|
|
|
|
1. **Open Form**: Open the "14 Process Sheet" form.
|
|
|
|
2. **Refresh Form Data**: Refresh the record source of the "Process Sheet" form to "Processes by material".
|
|
|
|
### Code Structure
|
|
|
|
```markdown
|
|
Private Sub Command3_Click()
|
|
|
|
' Open form and refresh data
|
|
DoCmd.OpenForm "14 Process Sheet"
|
|
Forms![14" Process Sheet"].recordSource = "Processes by material"
|
|
|
|
Exit_Command3_Click:
|
|
Exit Sub
|
|
|
|
Err_Command3_Click:
|
|
MsgBox Err.Description
|
|
Resume Exit_Command3_Click
|
|
```
|
|
|
|
**Note**: The provided code snippets are simplified versions of the original code. It is recommended to review and modify them according to your specific requirements and security standards.
|