Cybernomad
/
PSLine2000Documentation
1
0
Fork 0
Code Issues 1 Pull Requests Packages Projects 1 Releases Wiki Activity
PSLine2000Documentation/Forms/Material Upgrade.md

9.3 KiB
Raw Blame History

Material Upgrade

Analysis generated on: 4/1/2025 4:07:02 PM

Record Source

Controls

Control Name Reference
None -

VBA Code

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

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

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

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

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.