7.0 KiB

Raw Blame History

Latest Revision of parts

Analysis generated on: 4/1/2025 4:03:20 PM

Record Source

Queries/Processes by material

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 Description

This VBA code is part of an Access database application, and it appears to be a macro for automating tasks related to data processing and material selection.

Option Compare Database

The first line sets the option comparison level to "Database", which means that the code will compare strings using a database's collation settings.

Command13_Click

This is the main subroutine of interest. It performs the following tasks:

Opens two databases, MainDB and MainDB2, from the current workspace.
Enables Command16, which allows the user to open a form.
Sets up a status label (lblstatus) to display messages throughout the process.
Moves data from MainDB to MainDB2 using two Recordsets: RMSFILES#_IEMUP1A0 and Process by material.
- It first purges any existing records in MainDB2.
- Then, it moves each record from MainDB to MainDB2, updating the corresponding fields.
Activates an AS400 program (not shown in this code snippet) using a control (ActiveXCtl24).
Opens another query, "Processes by material 2d", and enables Command16 again after completion.

Command16_Click

This subroutine:

Opens a form named "14 Process Sheet" from the current database.
Sets the record source of the form to "Processes by material 4".
Closes the form when it's finished.

Command2_Click