• Home
 · 
• Miscellaneous
 · 
• Accessing using main form connection.

Accessing using main form connection.

Accessing using main form connection.

Rate Accessing using main form connection.

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

'Declaring an Event
Event resize() 'MappingInfo=UserControl,UserControl,-1,Resize
Event Click() 'MappingInfo=cmdReceive,cmdReceive,-1,Click
Event DblClick() 'MappingInfo=grdDataGrid,grdDataGrid,-1,DblClick
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyUp(KeyCode As Integer, Shift As Integer)
Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

'    Dim cnn As New ADODB.Connection
'    Dim rst As New ADODB.Recordset
'
'    Dim strProvider As String
'    Dim strDataSource As String
'    Dim strSQL As String
''''''''''''''''''''''''''''''
Dim m_db1 As Connection
Dim m_db2 As Connection
Dim m_db3 As Connection
''''''''''''''''''''''''''''''

''''''''''''''''''''''''''''''''''''''''''
Dim m_dbConnection1 As Connection
Dim m_dbConnection2 As Connection
Dim m_dbConnection3 As Connection
Dim m_dbConnection4 As Connection
Dim m_dbConnection5 As Connection
Dim m_dbConnection6 As Connection
''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''
'Create 2006.06.05
Dim m_strIniPath As String
Dim m_strUserID As String
'''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''
Dim m_enumLevel As tagEnum_WorkingLevel
Dim mbDataChanged As Boolean
''''''''''''''''''''''''''''''''''''''''''
Dim m_strfilter As String

'''''''''''''''''''''''''''''
Dim m_strFilterMin As String
Dim m_strFilterMax As String
'''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim WithEvents m_adoParts As Recordset
Dim WithEvents m_adoItemID As Recordset
Dim WithEvents m_adoCommon As Recordset
Dim WithEvents m_adoDefectiveParts As Recordset
Dim WithEvents m_adoCalibration As Recordset
Dim WithEvents m_adoSuppliers As Recordset
Dim WithEvents m_adoProductID As Recordset
Dim WithEvents m_adoRecBy As Recordset
Dim WithEvents m_adoInsBy As Recordset
Dim WithEvents m_adoAccBy As Recordset
Dim WithEvents m_adocost As Recordset
Dim WithEvents m_adobom As Recordset
Dim WithEvents m_adoFilteredRec As Recordset
''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Sub qrsResize()
    Dim lwidth As Long
    Dim lHeight As Long
    Dim pResult As Variant
On Error Resume Next

    grdDataGrid.Height = Me.ScaleHeight - 30 - picButtons.Height - picStatBox.Height
    lblStatus.Width = Me.Width - 1500
    cmdNext.Left = lblStatus.Width + 700
    cmdLast.Left = cmdNext.Left + 340

End Sub

Private Sub cmdAccept_Click()
On Error Resume Next

    If m_adoParts.RecordCount <= 0 Then
        MsgBox MESSAGE16
        Exit Sub
    End If
    frmAcceptItem.show vbModal, Me
    'modify amodia - 2006.05.27
    grdDataGrid.SetFocus
End Sub

Private Sub cmdEdit_Click()
On Error Resume Next

    If m_adoParts.RecordCount <= 0 Then
        MsgBox MESSAGE14
        Exit Sub
    End If
        frmUpdateItem.show vbModal, Me
        'modify amodia - 2006.05.27
        grdDataGrid.SetFocus
    Exit Sub
End Sub

Private Sub cmdFirst_Click()
On Error Resume Next
    
        m_adoParts.MoveFirst
        mbDataChanged = False
        grdDataGrid.SetFocus
    Exit Sub
End Sub

Private Sub cmdLast_Click()
On Error Resume Next

        m_adoParts.MoveLast
        mbDataChanged = False
        grdDataGrid.SetFocus
    Exit Sub
End Sub

Private Sub cmdNext_Click()
On Error Resume Next
    If Not m_adoParts.EOF Then m_adoParts.MoveNext
        If m_adoParts.EOF And m_adoParts.RecordCount > 0 Then
            Beep
            'moved off the end so go back
            m_adoParts.MoveLast

        End If
    'show the current record
    mbDataChanged = False
    grdDataGrid.SetFocus
    
    Exit Sub
End Sub

Private Sub cmdPrevious_Click()
On Error Resume Next
    If Not m_adoParts.BOF Then m_adoParts.MovePrevious
        If m_adoParts.BOF And m_adoParts.RecordCount > 0 Then
            Beep
            'moved off the end so go back
            m_adoParts.MoveFirst
        End If
    'show the current record
    mbDataChanged = False
    grdDataGrid.SetFocus
    
    Exit Sub
End Sub

Private Sub cmdReceive_Click()
    'RaiseEvent Click
On Error Resume Next
    frmPartsReceiving.show vbModal, Me
    'modify amodia - 2006.05.27
    grdDataGrid.SetFocus
    Exit Sub
End Sub

Private Sub cmdReset_Click()
'On Error Resume Next
'    Dim strSystem As String
'    Dim dCount As Integer
'
'    strSystem = App.Path + "\System"
'    m_adoParts.Filter = adFilterNone
'    m_adoParts.Requery
'    grdDataGrid.Columns(22).Visible = False
'    grdDataGrid.Columns(24).Visible = False
'    'modify amodia - 2006.05.27
'    grdDataGrid.SetFocus
    GetFilterALL
    denvPartsReceiving.Connection1.Close
    denvPartsReceiving.rsPartsReceiving.Close
    qrsInitialize 0
    grdDataGrid.Columns(24).Visible = False
    grdDataGrid.Columns(25).Visible = False
End Sub

Private Sub cmdSearch_Click()
On Error Resume Next
    If grdDataGrid.Text = "" Then
        MsgBox MESSAGE18
        Exit Sub
    End If
'    m_adoInsInventory.MoveFirst
    frmSearch.show vbModal, Me
    'modify amodia - 2006.05.27
    grdDataGrid.SetFocus
End Sub

Private Sub Form_Activate()
    '2006.06.05 Create J. Amodia
    grdDataGrid.Columns(24).Visible = False
    grdDataGrid.Columns(25).Visible = False

End Sub

Private Sub Form_Initialize()
'    m_strUserID = "DEFAULT"
End Sub

Private Sub Form_Load()
    Dim obj(5) As Object
    Dim strSystem As String
    ''    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
''    Added by J. Amodia - 2006.05.15
'    qrsPartsReceiving1.qrsEndApplication
''    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    strSystem = "\\Sv1102\qrs\System"
'    strSystem = "D:\Parts Receiving\System"
    
    Set m_db1 = New Connection
    Set m_db2 = New Connection
    Set m_db3 = New Connection

    m_db1.CursorLocation = adUseClient
    
    '**************Editable by J. Amodia **************************************************************************
    m_db1.CursorLocation = adUseClient
    m_db1.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=\\Sv1102\qrs\System\Common.mdb;"

    m_db2.CursorLocation = adUseClient
    m_db2.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=\\Sv1102\qrs\System\PartsInventory.mdb;"

    m_db3.CursorLocation = adUseClient
    m_db3.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=\\Sv1102\qrs\System\DefectiveParts.mdb;"



    '****************************************************************************************************************
    
    Set obj(0) = m_db1
    Set obj(2) = m_db3
    Set obj(4) = m_db2
    
    qrsSetAppDB obj, 1, 0
    qrsSetSystemPath App.Path, 0
    Me.qrsSetUserID "I-7", 0, 0

    qrsSetWorkingLevel WM_ADMIN, 0
    qrsHookMessage WM_FILTER, "1 / 1 / 2005", Now, 0
    GetFilter
    qrsInitialize 0
    
    grdDataGrid.Columns(24).Visible = False
    grdDataGrid.Columns(25).Visible = False
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    On Error Resume Next
    Me.prEndApplication
    End
End Sub

Private Sub Form_Resize()
    Me.qrsResize
End Sub

''''''''''''''''''''''''''''''''''''''''''''
'Set the Application Database.
'by J. Amodia 2006.05.17
''''''''''''''''''''''''''''''''''''''''''''
Private Sub qrsSetAppDB(dbObject() As Object, ldbCount As Long, pResult As Long)
    'set the database connection
    Set m_dbConnection1 = dbObject(0)
    Set m_dbConnection2 = dbObject(1)
    Set m_dbConnection3 = dbObject(2)
    Set m_dbConnection4 = dbObject(3)
    Set m_dbConnection5 = dbObject(4)
End Sub

''''''''''''''''''''''''''''''''''''''''''''
'Set the System Path.
'by J. Amodia 2006.05.17
''''''''''''''''''''''''''''''''''''''''''''
Private Sub qrsSetSystemPath(strSysPath As Variant, pResult As Variant)
    m_strIniPath = strSysPath
    m_strIniPath = App.Path + "\" + QRSINVENTORYINI '"\\Sv1102\qrs\System" + "\" + QRSINVENTORYINI
End Sub

''''''''''''''''''''''''''''''''''''''''''''
'Set the Working Level.
'by J. Amodia 2006.05.17
''''''''''''''''''''''''''''''''''''''''''''
Private Sub qrsSetWorkingLevel(nLevel As Variant, pResult As Variant)
    m_enumLevel = nLevel
    Select Case nLevel
        Case WM_MAKER
             SetControl (True)
        Case WM_ADMIN
             SetControl (True)
        Case WM_USER
            SetControl (True)
        Case WM_GUEST
             SetControl (False)
    End Select
End Sub

''''''''''''''''''''''''''''''''''''''''''''
'Set the Control.
'by J. Amodia 2006.05.17
''''''''''''''''''''''''''''''''''''''''''''
Private Sub SetControl(mControls As Boolean)
    cmdReceive.Enabled = mControls
    cmdEdit.Enabled = mControls
    cmdAccept.Enabled = mControls
End Sub

''''''''''''''''''''''''''''''''''''''''''''
'Set the Hook Message
'by J. Amodia 2006.05.17
''''''''''''''''''''''''''''''''''''''''''''
Public Function qrsHookMessage(lMsg As Long, wParam As Variant, lParam As Variant, lObj As Long)
    Dim strPath As String
    Dim File As String
    Select Case lMsg
        Case WM_SAVE
            SaveFile CStr(wParam), CStr(lParam)
'        Case WM_DELETE
'             mnuDelete_Click
'        Case WM_CLOSE
'            Unload Parent
        Case WM_PRINT
            PrintItems
        Case WM_FILTER
            m_strFilterMin = CStr(wParam)
            m_strFilterMax = CStr(lParam)
    End Select
End Function

''''''''''''''''''''''''''''''''''''''''''''
'Set the SaveFile
'by J. Amodia 2006.05.17
''''''''''''''''''''''''''''''''''''''''''''
Public Function SaveFile(strFilepath As String, strFilename As String)
    Dim fileNum As Integer
    Dim strTemp As String
    strTemp = strFilename 'strFilepath & strFilename 'create data path
    fileNum = FreeFile()
    Open strTemp For Output As #1
'    Print #fileNum, GetGridData
    GetGridData fileNum
    Close #fileNum
End Function

''''''''''''''''''''''''''''''''''''''''''''
'Set the PrintItems
'by J. Amodia 2006.05.17
''''''''''''''''''''''''''''''''''''''''''''
Private Sub PrintItems()
On Error Resume Next
    Wait (0.5)
    denvPartsReceiving.rsPartsReceiving.Update
    denvPartsReceiving.rsPartsReceiving.Resync adAffectAll, adResyncAllValues
    denvPartsReceiving.rsPartsReceiving.Requery
'    rptPartsReceiving.Orientation = rptOrientLandscape '

    Printer.PaperSize = vbPRPSA3
    rptPartsReceiving.ReportWidth = Printer.ScaleWidth
    rptPartsReceiving.show
    grdDataGrid.SetFocus
End Sub

''''''''''''''''''''''''''''''''''''''''''''
'Set the Initialize
'by J. Amodia 2006.05.17
''''''''''''''''''''''''''''''''''''''''''''
Private Sub qrsInitialize(pResult As Variant)
On Error Resume Next
    Dim nCount As Integer
    Dim dbObject(15) As Object
    Dim strSQL As String
    
'     GetFilter
    Set m_adoCommon = New Recordset
    Set m_adoDefectiveParts = New Recordset
    Set m_adoCalibration = New Recordset
    
'**********************************************************************
    'Recordset for the Parts Receiving

'    If m_enumLevel = WM_MAKER Or m_enumLevel = WM_ADMIN Then
'            strSQL = "SELECT Invoice_Number, Supplier_Order_Number, OPI_Order_Number," + _
'        "Supplier, Delivery_Date, Received_Date, Item_ID, Item_Name, IPMS_Price," + _
'        "Product_ID, Product_Name, Unit_Price, Invoice_Qty, Actual_Qty," + _
'        "Received_by, Total_Amount, OK_Qty, NG_Qty, Inspected_by, Accepted_by," + _
'        "Accepted_Date, Status, PR_code, Remarks, ID From PartsReceiving where Delivery_Date <= #" + m_strFilterMax + "#" + _
'        " AND DELIVERY_DATE >= #" + m_strFilterMin + "# order by DELIVERY_DATE"
'
'        'Original Code don't delete - important /2006.04.29
''        "Accepted_Date, Status, Remarks From PartsReceiving where Delivery_Date <= #" + m_strFilterMax + "#" + _
'        " AND DELIVERY_DATE >= #" + m_strFilterMin + "# order by DELIVERY_DATE"
'
'    ElseIf m_enumLevel = WM_USER Then
'            strSQL = "SELECT Invoice_Number, Supplier_Order_Number, OPI_Order_Number," + _
'        "Supplier, Delivery_Date, Received_Date, Item_ID, Item_Name, IPMS_Price," + _
'        "Product_ID, Product_Name, Unit_Price, Invoice_Qty, Actual_Qty," + _
'        "Received_by, Total_Amount, OK_Qty, NG_Qty, Inspected_by, Accepted_by," + _
'        "Accepted_Date, Status, PR_code, Remarks, ID From PartsReceiving order by Delivery_Date"
'
'        'Original Code don't delete - important /2006.04.29
''        "Accepted_Date, Status, Remarks From PartsReceiving where Remarks = 'For Inspection' or Remarks = 'Partial'" & _
'            "order by Devivery_Date"
'
'    ElseIf m_enumLevel = WM_GUEST Then
'            strSQL = "SELECT Invoice_Number, Supplier_Order_Number, OPI_Order_Number," + _
'        "Supplier, Delivery_Date, Received_Date, Item_ID, Item_Name, IPMS_Price," + _
'        "Product_ID, Product_Name, Unit_Price, Invoice_Qty, Actual_Qty," + _
'        "Received_by, Total_Amount, OK_Qty, NG_Qty, Inspected_by, Accepted_by," + _
'        "Accepted_Date, Status, PR_code, Remarks, ID From PartsReceiving order by Delivery_date"
'
'        'Original Code don't delete - important /2006.04.29
'        '"Accepted_Date, Status, Remarks From PartsReceiving where Remarks = 'Lot Out' or Remarks = 'Finished Inspection'" & _
'            "order by Delivery_date"
'    End If
    If m_strFilterMin <> "" And m_strFilterMax <> "" Then
        strSQL = "SELECT Delivery_Date, Item_ID, Item_Name, Actual_Qty," + _
        "Unit_Price, IPMS_Price, Invoice_Number, Supplier_Order_Number, OPI_Order_Number," + _
        "NG_Qty, Lack_XCS, Received_Date, Supplier, Product_ID, Product_Name,  Invoice_Qty," + _
        "Received_by, Total_Amount, OK_Qty, Inspected_by, Accepted_by," + _
        "Accepted_Date, Remarks, Status, PR_code, ID from PartsReceiving where DELIVERY_DATE <= #" + m_strFilterMax + "#" + _
        " AND DELIVERY_DATE >= #" + m_strFilterMin + "# AND STATUS " + m_strfilter + "order by DELIVERY_DATE"

    Else
        strSQL = "SELECT Delivery_Date, Item_ID, Item_Name, Actual_Qty," + _
        "Unit_Price, IPMS_Price, Invoice_Number, Supplier_Order_Number, OPI_Order_Number, Lack_XCS, " + _
        " Received_Date, Supplier, Product_ID, Product_Name,  Invoice_Qty," + _
        "Received_by, Total_Amount, OK_Qty, NG_Qty, Inspected_by, Accepted_by," + _
        "Accepted_Date, Remarks, Status, PR_code, ID from PartsReceiving order by DELIVERY_DATE"
    End If

    Set m_adoParts = New Recordset
    m_adoParts.Open strSQL, m_dbConnection5, adOpenStatic, adLockOptimistic

'**********************************************************************

    'Recordset for the Item ID
    Set m_adoItemID = New Recordset
        m_adoItemID.Open "select ITEM_ID, ITEM_NAME from ITEMS order by ITEM_ID ", m_dbConnection1, adOpenStatic, adLockOptimistic
        
    Set m_adocost = New Recordset
        m_adocost.Open "Select ITEM_ID, UNIT_COST from ITEM_COST order by ITEM_ID", m_dbConnection1, adOpenStatic, adLockOptimistic

    Set m_adobom = New Recordset
        m_adobom.Open "Select PARENT_ITEM_ID, COMPONENT_ITEM_ID, END_ORG_NO from BOM WHERE (END_ORG_NO = 999) order by PARENT_ITEM_ID", m_dbConnection1, adOpenStatic, adLockOptimistic

    'Recordset for the Supplier
    Set m_adoSuppliers = New Recordset
        m_adoSuppliers.Open "select SUPP_ID, SUPP_NAME from SUPPLIERS order by SUPP_ID", m_dbConnection1, adOpenStatic, adLockOptimistic

    'Recordset for the Product Name
    Set m_adoProductID = New Recordset
        m_adoProductID.Open "select ID, PRODUCT_NAME from PRODUCT_NAME order by PRODUCT_NAME ", m_dbConnection1, adOpenStatic, adLockOptimistic

    'Recordset for the Received by
    Set m_adoRecBy = New Recordset
        m_adoRecBy.Open "select LAST_NAME, TEAM from INCHARGE where TEAM = 'PURCHASING' order by LAST_NAME", m_dbConnection1, adOpenStatic, adLockOptimistic

    'Recordset for the Inspected By and the Accepted by
    Set m_adoInsBy = New Recordset
        m_adoInsBy.Open "select LAST_NAME, TEAM from INCHARGE where TEAM = 'INSPECTION' order by LAST_NAME", m_dbConnection1, adOpenStatic, adLockOptimistic

    Set m_adoAccBy = New Recordset
        m_adoAccBy.Open "select LAST_NAME, TEAM from INCHARGE where TEAM = 'WAREHOUSE' OR TEAM = 'SHIPPING' order by LAST_NAME", m_dbConnection1, adOpenStatic, adLockOptimistic


    'Set filter setting
    frmFilterSetting.SetDBOject m_adoParts, m_dbConnection5

    'Set the Parts Receiving database as grdDataGrid Recordset
    Set grdDataGrid.DataSource = m_adoParts
    grdDataGrid.Refresh

    'Pass the recordset
    Set dbObject(0) = m_adoParts
    Set dbObject(1) = m_adoSuppliers
    Set dbObject(2) = m_adoItemID
    Set dbObject(3) = m_adoProductID
    Set dbObject(4) = m_adoRecBy
    Set dbObject(5) = m_adoInsBy
    Set dbObject(6) = m_adoAccBy
    Set dbObject(7) = m_adocost
    Set dbObject(8) = m_adobom
    Set dbObject(9) = m_adoFilteredRec

    'set the db connection for the Item Receiving form
    frmPartsReceiving.SetDBRecordset dbObject
    'set the db connection for the item Accepting form
    frmAcceptItem.SetDBRecordset dbObject
    'set the db connection for the item Accepting form
    frmUpdateItem.SetDBRecordset dbObject
    'set the db connection for the items form
    'frmItemID.SetDBRecordset dbObject
    'set the db connection for the Search Item form
    frmSearch.SetDBRecordset dbObject
    
    'Data Environment Connection
    denvPartsReceiving.Connection1.Open m_dbConnection5.ConnectionString
    '
    denvPartsReceiving.rsPartsReceiving.Open strSQL, m_dbConnection5, adOpenStatic, adLockOptimistic
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Set the GetGridData
'----------------------#will be use in SaveFile Function#
'by J. Amodia 2006.05.17
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetGridData(nfileNum As Integer)

    Dim nRCount As Integer
    Dim nCCount As Integer
    Dim nDCount As Integer
    Dim strTemp As String
    Dim strCaption As String
    Dim strTemp2 As String
    Dim strTempRec As String
    Dim adoRecTemp As Recordset

    Set adoRecTemp = New Recordset

    'Show progress bar
    nDCount = m_adoParts.RecordCount
    Set adoRecTemp = m_adoParts.Clone
    adoRecTemp.Filter = m_adoParts.Filter
    frmProgressBar.prgBar.Max = nDCount
    frmProgressBar.Caption = "Saving data into File"
    frmProgressBar.show vbModeless

    adoRecTemp.AbsolutePosition = 1
    'Retrieve caption name
    For nCCount = 0 To GRDCOLNUMBER - 1
        strCaption = strCaption + CStr(adoRecTemp(nCCount).Name) + ","
    Next nCCount
    
    Print #nfileNum, strCaption
    For nRCount = 0 To nDCount - 1
        For nCCount = 0 To GRDCOLNUMBER - 1
            If IsNull(adoRecTemp(nCCount)) <> True Then
                strTempRec = CStr(adoRecTemp.Fields(nCCount).Value)
            Else
                strTempRec = ""
            End If
                strTemp2 = Replace(strTempRec, ",", ";")
                strTemp2 = Replace(strTemp2, vbCrLf, " ")
                strTemp = strTemp + strTemp2 + ","
        Next nCCount

        Print #nfileNum, strTemp
'        Debug.Print strTemp
        adoRecTemp.AbsolutePosition = nRCount + 1
        strTemp = ""
        frmProgressBar.prgBar.Value = nRCount
    Next nRCount
         
'    m_adoParts.MoveFirst
    GetGridData = strCaption + vbCrLf + strTemp
    frmProgressBar.Hide
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Set the FunctionWait
'----------------------#will be use in SaveFile Function#
'by J. Amodia 2006.05.17
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Wait(dWaitTime As Double) As Boolean
    Dim dStartTime As Double
    Dim dCurrentTime As Double
    Dim nRetEvent As Integer
    dStartTime = Timer          'Starting time
    Do
        nRetEvent = DoEvents()
        If dStartTime > Timer Then
            'Timer will reset to 0 in the midnight, so if current time will be less than
            'the start time, time wrap-up occurs.  Thus, it is necessary to reset start
            'time to 0
            dStartTime = 0
        End If
        If Timer > dStartTime + dWaitTime Then
            Exit Do                      'exit
        End If
    Loop
End Function

Private Sub grdDataGrid_DblClick()
On Error Resume Next
    RaiseEvent DblClick
    cmdEdit_Click
End Sub

Private Sub grdDataGrid_GotFocus()
    grdDataGrid.Columns(24).Visible = False
    grdDataGrid.Columns(25).Visible = False
End Sub

Private Sub grdDataGrid_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
    If Button = vbRightButton Then
        PopupMenu mFile
    End If
End Sub

Private Sub grdDataGrid_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
    If Button = vbRightButton Then
        PopupMenu frmMainParts.mFile
    End If
End Sub

Private Sub lblStatus_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
        PopupMenu mFile
    End If
End Sub

''''''''''''Set the Current Record into the Label
Private Sub m_adoParts_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    Dim strRec As String
On Error Resume Next
    strRec = CStr(m_adoParts.AbsolutePosition)
    'This will display the current record position for this recordset
    lblStatus.Caption = "Record No: " & strRec
End Sub

Private Sub mnuAccept_Click()
On Error Resume Next

    If m_adoParts.RecordCount <= 0 Then
        MsgBox MESSAGE16
        Exit Sub
    End If
    frmAcceptItem.show vbModal, Me
    'modify amodia - 2006.05.27
    grdDataGrid.SetFocus
End Sub

Private Sub mnuDelete_Click()
    Dim iAnswer As Integer
'    On Error GoTo DelError
    
    If m_adoParts.RecordCount <= 0 Then
        MsgBox MESSAGE23
        Exit Sub
    End If
On Error Resume Next
    If mnuDelete.Enabled = True Then
        If m_adoParts.EOF = False And m_adoParts.BOF = False Then
            iAnswer = MsgBox("Are you sure you want to delete this record?", _
            vbYesNo + vbQuestion, "Confirm Delete?")
                If iAnswer = vbYes Then
                   With m_adoParts
                        DoEvents
                       .Delete 'adAffectCurrent       'deletes the record in the System
                       .Update

                        denvPartsReceiving.rsPartsReceiving.Requery
                        denvPartsReceiving.rsPartsReceiving.Update
                        .Requery
                   End With
                End If
                denvPartsReceiving.rsPartsReceiving.Requery
        End If
    End If

    grdDataGrid.Columns(24).Visible = False
    grdDataGrid.Columns(25).Visible = False

'    Wait (0.5)
    
    Exit Sub
'DelError:
'        If Err = -2147217864 Then
'            Resume Next
'        End If
End Sub

Private Sub mnuEdit_Click()
On Error Resume Next

    If m_adoParts.RecordCount <= 0 Then
        MsgBox MESSAGE14
        Exit Sub
    End If
        frmUpdateItem.show vbModal, Me
        'modify amodia - 2006.05.27
        grdDataGrid.SetFocus
    Exit Sub
End Sub

Private Sub mnuFilter_Click()
    frmFilterSetting.show vbModal
End Sub

Private Sub mnuReceive_Click()
    frmPartsReceiving.show vbModal, Me
End Sub

Private Sub mnuReset_Click()
    cmdReset_Click
End Sub

Private Sub mnuSave_Click()
  
    Dim wParam As Variant
    Dim lParam As Variant


    Dim sFile As String
    Dim sPath As String
    'If Left$(ActiveForm.Caption, 8) = "Document" Then
    On Error Resume Next
    
    If grdDataGrid.Text = "" Then
        MsgBox MESSAGE22
        Exit Sub
    End If
    
        Me.Enabled = False
        With dlgParts
            .DialogTitle = "Save"
            .CancelError = True
            'ToDo: set the flags and attributes of the common dialog control
            .Filter = "CSV File (*.csv)|*.csv| Excel File (*.xls)|*.xls| Text File (*.txt)|*.txt"
            .Flags = cdlOFNOverwritePrompt
            .ShowSave
            If Len(.FileName) <= 0 Or Err Then
                Me.Enabled = True
                Exit Sub
            End If
            sPath = .FileName
            sFile = .FileTitle
            sPath = Left(sPath, Len(sPath) - Len(sFile))
                      
        End With
    Me.MousePointer = vbHourglass
    Me.qrsHookMessage WM_SAVE, sPath, sFile, 0
    Me.MousePointer = vbArrow
    Me.Enabled = True
End Sub

Private Sub mnuSearch_Click()
On Error Resume Next
    If grdDataGrid.Text = "" Then
        MsgBox MESSAGE18
        Exit Sub
    End If
'    m_adoInsInventory.MoveFirst
    frmSearch.show vbModal, Me
    'modify amodia - 2006.05.27
    grdDataGrid.SetFocus
End Sub

Public Sub prEndApplication()
On Error Resume Next
'    modify 2006.06.14
    SetFilter
    SaveGridwidth

    m_adoParts.Close
    m_adoSuppliers.Close
    m_adoItemID.Close
    m_adoProductID.Close
    m_adoRecBy.Close
    m_adoInsBy.Close
    m_adoAccBy.Close
    m_adocost.Close
    m_adoRecBy.Close
    m_adobom.Close
    m_adoFilteredRec.Close
    
    denvPartsReceiving.rsPartsReceiving.Close
    
    Set denvPartsReceiving = Nothing
    Set m_dbConnection1 = Nothing
    Set m_dbConnection2 = Nothing
    Set m_dbConnection3 = Nothing
    Set m_dbConnection4 = Nothing
    Set m_dbConnection5 = Nothing
    Set m_dbConnection6 = Nothing
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Set the GetFilter
'----------------------#initialize function use#
'by J. Amodia 2006.06.05
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Sub GetFilter()
    frmFilterSetting.g_strDateMin = ReadIniFile(m_strUserID, "MIN_DATE", m_strIniPath)
    frmFilterSetting.g_strDateMax = ReadIniFile(m_strUserID, "MAX_DATE", m_strIniPath)
    frmFilterSetting.cboFilter.ListIndex = Val(ReadIniFile(m_strUserID, "FILTER", m_strIniPath))
    frmFilterSetting.cboDate.ListIndex = Val(ReadIniFile(m_strUserID, "DATE_INDEX", m_strIniPath))
    
    If frmFilterSetting.cboFilter.ListIndex = 0 Then
         m_strfilter = ""
    ElseIf frmFilterSetting.cboFilter.ListIndex = 1 Then
        m_strfilter = "= 'For Inspection'"
    ElseIf frmFilterSetting.cboFilter.ListIndex = 2 Then
        m_strfilter = "= 'Finished Inspection'"
    End If
        
    If m_strUserID <> "DEFAULT" Then
        m_strFilterMin = frmFilterSetting.g_strDateMin
        m_strFilterMax = frmFilterSetting.g_strDateMax
    Else
        m_strFilterMin = Format(DateAdd("m", -3, Now), "mm/dd/yyyy")
        m_strFilterMax = Format(Now, "mm/dd/yyyy")
    End If

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Set the GetFilter All
'----------------------#initialize function use#
'by J. Amodia 2006.06.05
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub GetFilterALL()
        m_strFilterMin = ""
        m_strFilterMax = ""
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Set the SetFilter
'----------------------#initialize function use#
'by J. Amodia 2006.06.08
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub SetFilter()
    WriteIniFile m_strUserID, "FILTER", frmFilterSetting.cboFilter.ListIndex, m_strIniPath
    WriteIniFile m_strUserID, "DATE_INDEX", frmFilterSetting.cboDate.ListIndex, m_strIniPath
    WriteIniFile m_strUserID, "MIN_DATE", frmFilterSetting.g_strDateMin, m_strIniPath
    WriteIniFile m_strUserID, "MAX_DATE", frmFilterSetting.g_strDateMax, m_strIniPath