by Julito Amodia (8 Submissions)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Mon 26th June 2006
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Accessing using main form connection.
VBcoders
'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
