frmlocationsae.frm

Inventory control system

    dcCities.Text = ""
    lvCities.ListItems.Clear
    txtEntry(1) = ""
End Sub


Private Sub CmdSave_Click()
On Error GoTo erR
  
  'check for blank category
  If Trim(dcRoute.Text) = "" Then
    MsgBox "Please specify a route for the cities.", vbExclamation
    Exit Sub
  End If
  'check for blank unit measures
  If lvCities.ListItems.Count < 0 Then
    MsgBox "Please provide at least one city.", vbExclamation
    Exit Sub
  End If
  
      
 ' If State = adStateAddMode Or State = adStatePopupMode Then
  '  rs.AddNew
    'rs.Fields("StockId") = PK
    
  'Else
    
  'End If
  
  'Dim RouteID As Long
  
  'With rs
  '  .Fields("CityID") = GetCityID(lvCities.ListItems(Y).SubItems(1))
  '  .Fields("RouteID") = dcRoute.BoundText
  '
  '  .Update
  'End With
  
  'delete all stockunit on the array d
  Dim ctr As Long
  For ctr = 0 To b - 1
    CN.Execute "Delete * From Locations Where LocationID=" & d(ctr)
  Next
    
  'save stockunit
  'rsPMeasures.CursorLocation = adUseClient
  'rsPMeasures.Open "SELECT * FROM Stock_Unit WHERE StockId = " & PK, CN, adOpenStatic, adLockOptimistic
  
  Dim I As Long
  With lvCities
    
    For I = 1 To .ListItems.Count
      If State = adStateAddMode Or State = adStatePopupMode Then
AddNew:
        If rs.State = 1 Then rs.Close
        rs.CursorLocation = adUseClient
        rs.Open "SELECT * FROM Locations", CN, adOpenStatic, adLockOptimistic
        
        'new stock new unit(s)
        rs.AddNew
        'rs.Fields("addedbyfk") = CurrUser.USER_PK
        rs.Fields("CityID") = GetCityID(.ListItems(I).SubItems(1))
        rs.Fields("RouteID") = dcRoute.BoundText
        rs.Update
        
      Else
        If LocationExist(dcRoute.Text, .ListItems(I).SubItems(1)) Then
          'update
          If rs.State = 1 Then rs.Close
          rs.CursorLocation = adUseClient
          rs.Open "SELECT * FROM Locations WHERE LocationID = " & .ListItems(I).SubItems(3), CN, adOpenStatic, adLockOptimistic
          
          rs.Fields("CityID") = .ListItems(I).SubItems(2)
          rs.Fields("RouteID") = dcRoute.BoundText
          rs.Update
          rs.MoveNext
          
         ' rs.Fields("datemodified") = Now
         ' rs.Fields("lastuserfk") = CurrUser.USER_PK
        Else
          GoTo AddNew       'if new unit added to the existing unit(s)
        End If
      End If
      
      
      
    Next
  End With
  
  
    
  HaveAction = True
    
  If State = adStateAddMode Then
    MsgBox "New record has been successfully saved.", vbInformation
    If MsgBox("Do you want to add another new record?", vbQuestion + vbYesNo) = vbYes Then
      ResetFields
    Else
      Unload Me
    End If
  ElseIf State = adStatePopupMode Then
    MsgBox "New record has been successfully saved.", vbInformation
    Unload Me
  Else
    MsgBox "Changes in  record has been successfully saved.", vbInformation
    Unload Me
  End If
  
  Exit Sub
erR:
  MsgBox "Error: " & erR.Description, vbExclamation
End Sub

Private Sub cmdUsrHistory_Click()
    On Error Resume Next
    Dim tDate1 As String
    Dim tDate2 As String
    Dim tUser1 As String
    Dim tUser2 As String
    
    tDate1 = Format$(rs.Fields("DateAdded"), "MMM-dd-yyyy HH:MM AMPM")
    tDate2 = Format$(rs.Fields("DateModified"), "MMM-dd-yyyy HH:MM AMPM")
    
    tUser1 = getValueAt("SELECT PK,CompleteName FROM tbl_SM_Users WHERE PK = " & rs.Fields("AddedByFK"), "CompleteName")
    tUser2 = getValueAt("SELECT PK,CompleteName FROM tbl_SM_Users WHERE PK = " & rs.Fields("LastUserFK"), "CompleteName")
    
    MsgBox "Date Added: " & tDate1 & vbCrLf & _
           "Added By: " & tUser1 & vbCrLf & _
           "" & vbCrLf & _
           "Last Modified: " & tDate2 & vbCrLf & _
           "Modified By: " & tUser2, vbInformation, "Modification History"
           
    tDate1 = vbNullString
    tDate2 = vbNullString
    tUser1 = vbNullString
    tUser2 = vbNullString
End Sub

'Procedure used to generate PK
Private Sub GeneratePK()
  PK = getIndex("Locations")
End Sub


Private Function GetCityID(ByVal City As String) As Long
  Dim sql As String
  Dim rstemp As New Recordset
  
  sql = "SELECT Cities.CityID " _
  & "From Cities WHERE (((Cities.City)='" & Replace(City, "'", "''") & "'))"
  
  rstemp.Open sql, CN, adOpenDynamic, adLockOptimistic
  If Not rstemp.EOF Then GetCityID = rstemp!CityID
  
  Set rstemp = Nothing
End Function





Private Sub Form_Load()
   'If rs.State = 1 Then rs.Close
    
    
    'rs1.CursorLocation = adUseClient
    'rs1.Open "SELECT * FROM qry_Stock_Unit WHERE StockId = " & PK, CN, adOpenStatic, adLockOptimistic
    
    'bind_dc "SELECT * FROM Stocks_Category order by category asc", "Category", dcRoute, "CategoryID", True
    bind_dc "SELECT * FROM Routes Order By Route Asc", "Route", dcRoute, "RouteID", True
    bind_dc "SELECT * FROM Cities Order By City Asc", "City", dcCities, "CityID", True
        
    'Check the form state
    If State = adStateAddMode Or State = adStatePopupMode Then
        Caption = "Create New Entry"
        cmdUsrHistory.Enabled = False
        dcRoute.Text = ""
        dcCities.Text = ""
        'GeneratePK
    Else
      b = 0
        
        Caption = "Edit Entry"
        DisplayForEditing
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If HaveAction = True Then
        If State = adStateAddMode Or State = adStateEditMode Then
            frmLocations.RefreshRecords
        ElseIf State = adStatePopupMode Then
            srcText.Text = txtEntry(0).Text
            srcText.Tag = PK
            On Error Resume Next
            srcTextAdd.Text = rs![DisplayAddr]
            srcTextCP.Text = txtEntry(6).Text
            'srcTextDisc.Text = toNumber(cmdDisc.Text)
        End If
    End If
    
    Set frmLocationsAE = Nothing
End Sub

Private Sub lvList_BeforeLabelEdit(Cancel As Integer)

End Sub

Private Sub lvList_DblClick()
  
End Sub



'Private Sub lvPriceHistory_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
'  With lvPriceHistory
    'MsgBox .ColumnHeaders(2).Width & vbCr _
    & .ColumnHeaders(3).Width & vbCr _
    & .ColumnHeaders(4).Width
  
'  End With
'End Sub

Private Sub lvCities_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
  With lvCities
    'MsgBox .ColumnHeaders(2).Width & vbCr _
    & .ColumnHeaders(3).Width & vbCr _
    & .ColumnHeaders(4).Width & vbCr _
    & .ColumnHeaders(5).Width & vbCr _
    & .ColumnHeaders(6).Width & vbCr _

  End With
End Sub

Private Sub lvCities_DblClick()
  With lvCities
    dcCities.Text = .ListItems(.SelectedItem.Index).SubItems(1)
    'txtEntry(10).Text = .ListItems(.SelectedItem.Index).SubItems(5)
    'dcCities.Text = .ListItems(.SelectedItem.Index).SubItems(2)
    pm_ID = .SelectedItem.Index
    'txtEntry(10).Text = .ListItems(.SelectedItem.Index).SubItems(4)
    'dcChild.Text = .ListItems(.SelectedItem.Index).SubItems(5)
  End With
End Sub

Private Sub lvCities_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = 46 Then
    With lvCities
      If .ListItems.Count <= 0 Then Exit Sub
      
      If .ListItems(.SelectedItem.Index).SubItems(3) <> "" Then
        d(b) = .ListItems(.SelectedItem.Index).SubItems(3)        'place unitid to the element b of the array
        b = b + 1
      End If
      
      .ListItems.Remove (.SelectedItem.Index)
    End With
  End If
End Sub

Private Sub txtEntry_GotFocus(Index As Integer)
    If Index = 8 Then cmdSave.Default = False
    HLText txtEntry(Index)
End Sub

Private Sub txtEntry_KeyPress(Index As Integer, KeyAscii As Integer)
  If Index = 9 Or Index = 10 Then KeyAscii = isNumber(KeyAscii)
End Sub

Private Sub txtEntry_LostFocus(Index As Integer)
    If Index = 8 Then cmdSave.Default = True
End Sub