Private Sub Command1_Click()
    On Error GoTo hell
    If Text1.Text = "" Or IsNumeric(Text1.Text) = False Or Text1.Text < 0 Or Text2.Text = "" Or IsNumeric(Text2.Text) = False Or Text2.Text < 0 Then
    GoTo hell
    Exit Sub
Else
    SaveSetting App.Title, "Settings", "Fine Amount", CStr(CCur(Text2.Text))
    SaveSetting App.Title, "Settings", "Max Days", CStr(CCur(Text1.Text))
    Unload Me
End If
Exit Sub
hell:
    MsgBox "You have Entered an invalis character or no characters at all in the textboxes" & vbNewLine & "therefore you cannot save the settings" & vbNewLine & "You can enter only numeric data in the boces", vbExclamation
End Sub

Private Sub Command1_Click()
    On Error GoTo Err
    If Text1.Text = "" Then Text1.Text.SetFocus: Exit Sub
    If Combo1.Text = "" Then Combo1.Text.SetFocus: Exit Sub
    With SourceRS
      If AlreadySearched = False Then
         oldpos = .AbsolutePosition
         .MoveFirst
         .Find "[" & Combo1.Text & "] like *" & Text1.Text & "*"
         CurrPos = .AbsolutePosition
         If .EOF Then
           MsgBox "Could not find'" & Text1.Text & " 'in' " & Combo1.Text & " '. ", vbExclamation
        .AbsolutePosition = oldpos
        Else
          AlreadySerached = True
          Command1.Caption = "查找下一个"
        End If
    Else
       oldpos = .AbsolutePosition
       .MoveNext
       .Find "[" & Combo1.Text & "] like * " & Text1.Text & "*"
       CurrPos = .AbsolutePosition
       If .EOF Then MsgBox "Search completed.", vbInformation: AlreadySerached = False: .AbsolutePosition = oldpos
    End If
End With
Exit Sub
Err:
    If Err.Number = -2147217881 Then Search_Number: Resume Next
   If Err.Number = 3265 Then MsgBox "从这个列表中选择一个有效值", vbExclamation: HighLight Text1.Text: Exit Sub
    Handler Err
End Sub

Private Sub Search_Number()
   On Error GoTo Err
   SourceRS.Find "[" & Combo1.Text & "] like " & Text1.Text & ""
Exit Sub
Err:
   Search_DataTime
   
End Sub
Private Sub Search_DataTime()
   On Error GoTo Err
   SourceRS.Find "[" & Combo1.Text & "] like #" & Text1.Text & "#"
   Exit Sub
Err:
   MsgBox "请输入一个合适的值" & vbCrLf & "where to find it .", vbExclamation
End Sub
Private Sub Command2_Click()
  Unload Me
End Sub

Private Sub Form_Load()
    Fillcombo Combo1, SourceRS, False
    Me.Icon = Image1.Picture
    Combo1.ListIndex = 0
End Sub

Private Sub cmdAMod_Click(Index As Integer)
    On Error Resume Next
       With frmBooksAE
          .AddState = Index
          .OldID = RS.Fields(0)
          If Index = 0 Then
             .msdIDText = RS.Fields(0)
             .txtTitle.Text = RS.Fields(1)
             .txtAuthor.Text = RS.Fields(2)
             .txtPublisher.Text = RS.Fields(3)
             .cmbCategory.Text = RS.Fields(4)
             .txtPrice.Text = RS.Fields(5)
             msdISBN.Text = RS.Fields(6)
          End If
          .Show vbModal
        End With
        cmdRefresh_Click
        DisplayRecords

End Sub

Private Sub cmdClose_Click()
Unload Me
End Sub

Private Sub cmdDelete_Click()
Dim ans As Integer
On Error GoTo hell
    With RS
       If .RecordCount < 1 Then MsgBox "没有记录可以删除", vbExclamation: Exit Sub
       If .Fields("是否出借") = True Then MsgBox "你不可以删除这条记录，因为该书已被人借走" & vbNewLine & "这本书的记录必须归还后才能删除", vbInformation, "该书被借走"
       ans = MsgBox("你确定删除这条记录吗？？", vbCritical + vbYesNo, "确认删除记录")
       Screen.MousePointer = vbHourglass
       If ans = vbYes Then
       pos = .AbsolutePosition
       CN.BeginTrans
       .Delete
       .Requery
       CN.CommitTrans
       If pos > .RecordCount Then
         If Not .EOF Or .BOF Then .MoveFirst
        Else
          .AbsolutePosition = pos
        End If
        MsgBox "记录已经被成功删除", vbInformation, "确认"
        End If
        Screen.MousePointer = vbDefault
    End With
Exit Sub
hell:
    On Error Resume Next
      Handler Err
      CN.RollbackTrans
       
End Sub

Private Sub cmdRefresh_Click()
    With RS
        .Filter = adFilterNone
        .Requery
    End With
    DisplayRecords
End Sub

Private Sub DataGrid1_KeyUp(KeyCode As Integer, Shift As Integer)
  If KeyCode = 38 Or KeyCode = 40 Then DisplayRecords

End Sub

Private Sub Form_Load()
  On Error GoTo hell
  Set RS = New ADODB.Recordset
  RS.CursorLocation = adUseClient
  RS.Open "SELECT * From tblBooks", CN, adOpenDynamic, adLockOptimistic
  Set DataGrid1.DataSource = RS
  DisplayRecords
  With frmmain.ImgList32
     cmdReport(1).Picture = .ListImages(6).Picture
     cmdReport(0).Picture = .ListImages(6).Picture
 End With
hell:
   Handler Err
   Resume Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
  Set RS = Nothing
  Set FrmBooks = Nothing
  
End Sub

Private Sub cmdOperations_Click(Index As Integer)
Dim obj As Form
   If Index = 0 Then Set obj = frmSearch
   If Index = 1 Then Set obj = FrmFilter
   If Index = 2 Then Set obj = frmSort
   With obj
      Set .SourceRS = RS
      .Show vbModal
    End With
    Set obj = Nothing
End Sub
Private Sub DisplayRecords()
   Dim i As Integer
   On Error Resume Next
     With RS
        If .RecordCount < 1 Then
         txtcount.Text = 0
        Else
         txtcount.Text = .AbsolutePosition
        End If
        lblmax.Caption = .RecordCount
        For i = 0 To 6
          txtDisp(i).Text = .Fields(i)
          Next i
        End With
    txtDisp(5).Text = FormatCurrency$(txtDisp(5).Text)
End Sub

Private Sub SSTab1_DblClick(Index As Integer)

End Sub

Private Sub cmdReset_Click()
   msdID.Text = ""
   txtTitle.Text = ""
   txtAuthor.Text = ""
   txtPublisher.Text = ""
   txtPrice.Text = ""
   msdISBN.Text = ""
   cmbCategory.ListIndex = 0
End Sub

Private Sub Form_Load()
   On Error GoTo Err
   Set RS = New ADODB.Recordset
   If AddState Then
     Image1.Picture = FrmBooks.cmdAMod(1).Picture
     RS.Open "SELECT * FROM tblBooks", CN, adOpenStatic, adLockOptimistic
     Me.Caption = "修改记录"
    Else
     Image1.Picture = FrmBooks.cmdAMod(0).Picture
     Me.Caption = "修改记录"
     cmdAddSave.Caption = "保存"
     RS.Open "SELECT * From tblBooks WHERE [图书编号] ='" & OldID & " '", CN, adOpenStatic, adLockOptimistic
    End If
Exit Sub
Err:
  If Err.Number = 94 Or Err.Number = 3265 Then
    Resume Next
  Else
    Handler Err
End If
End Sub
Private Sub cmdAddSave_Click()
    On Error GoTo hell
    If msdID.Text = "" Then txtTitle.SetFocus: Exit Sub
    If txtTitle.Text = "" Then txtTitle.SetFocus: Exit Sub
    If Len(msdID.Text) <> 10 Then MsgBox "All 图书编号 must be 10 charecters long", vbExclamation: HighLight msdID: Exit Sub
    msdID.Text = UCase$(msdID.Text)
    If IsNumeric(Right$(msdID.Text, 9)) = False Then MsgBox "图书编号 must start with B follower by 9 digits", vbExclamation: HighLight msdID: Exit Sub
    If AddState Then
      If RecordExists("tblBooks", "图书编号", msdID.Text, msdID) = True Then Exit Sub
      Else
         If msdID.Text <> OldID Then
           If RecordExists("tblBooks", "图书编号", msdID.Text, msdID) = True Then Exit Sub
       End If
      End If
      CN.BeginTrans
      With RS
        If AddState = True Then RS.AddNew
        .Fields(0) = msdID.Text
        .Fields(1) = txtTitle.Text
        .Fields(4) = cmbCategory.Text
        .Fields(5) = CCur(txtPrice.Text)
        .Fields(6) = msdISBN.Text
        If txtAuthor.Text = "" Then .Field(2) = " " Else .Field(2) = txtAuthor.Text
        If txtPublisher.Text = "" Then .Field(3) = " " Else .Field(3) = txtPublisher.Text
        If txtPrice.Text = "" Then txtPrice.Text = "0"
        RS.Update
    End With
    CN.CommitTrans
    If AddState Then
       FindRecords RS, RS.Fields(0).Name, True, msdID.Text, 0
       MsgBox "新的记录被成功添加", vbInformation
       If MsgBox("你真的要添加新记录吗？？", vbQuestion + vbYesNo + vbDefaultButton1) = vbYes Then
          cmdReset_Click
        Else
           Unload Me
        End If
Exit Sub
hell:
   On Error Resume Next
     Handler Err
     CN.RollbackTrans

End Sub
Private Sub cmdCancel_Click()
  Unload Me
End Sub

Private Sub Command1_Click()
    On Error GoTo Err
    If Text1.Text = "" Then Text1.SetFocus: Exit Sub
    If Combo1.Text = "" Then Combo1.SetFocus: Exit Sub
    SourceRS.Filter = "[" & Combo1.Text & "] like *" & Text1.Text & "*"
    Unload Me
Exit Sub
Err:
    If Err.Number = 3001 Then MsgBox "请从列表中选择一个有效的值", vbExclamation: Text1.Text = "": Combo1.SetFocus: Exit Sub
    If Err.Number = -2147217825 Then Search_Number: Resume Next: Exit Sub
    Handler Err
End Sub
Private Sub Search_Number()
   On Error GoTo Err
   SourceRS.Filter = Combo1.Text & " like " & Text1.Text & ""
Exit Sub
Err:
   Search_Data_Time
End Sub
Private Sub Search_Data_Time()
   On Error GoTo Err
   SourceRS.Filter = Combo1.Text & " like #" & Text1.Text & "#"
   Exit Sub
Err:
   MsgBox "请输入一个合适的值" & vbCrLf & "where to find it.", vbExclamation
End Sub

Private Sub Command2_Click()
  Unload Me
End Sub

Private Sub Form_Load()
   Me.Icon = Image1.Picture
   Fillcombo Combo1, SourceRS, False
   Combo1.ListIndex = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
   Set SourceRS = Nothing
   Set FrmFilter = Nothing
   
End Sub

Private Sub cmdBook_Click()
   With frmSelectDg
     .CommandText = "Select * From tblBooks where 是否出借=False"
     .DataGrid1.Caption = "Members Table"
     .Show vbModal
     If .OKPressed Then
        Text5.Text = .rRS1
        Text2.Text = .rRS2
    End If
End With
End Sub

Private Sub cmdCode_Click()
Dim A As String, b As String
    With frmSelectDg
       .CommandText = "Select * Form tblMembers"
       .DataGrid1.Caption = "Members Table"
       .Show vbModal
    If .OKPressed Then
       Text4.Text = .rRS1
       A = .rRS2
       b = .rRS3
       Text1.Text = A & " " & b
    End If
End With
End Sub

Private Sub cmdIssue_Click()
Dim RS As ADODB.Recordset
   If Text4.Text = "" Then Text4.SetFocus: Exit Sub
   If Text5.Text = "" Then Text5.SetFocus: Exit Sub
   On Error GoTo hell
   CN.BeginTrans
   Set RS = New ADODB.Recordset
   With RS
       .Open "Select * From tblTrans", CN, adOpenDynamic, adLockOptimistic
       .AddNew
       .Fields(0) = Text5.Text
       .Fields(1) = Text4.Text
       .Fields(2) = Data
       .Update
       .Close
       .Open "Select [是否出错] From tblBooks where [图书编号]= '" & Text5.Text & " ' ", CN, adOpenDynamic, adLockOptimistic
       .MoveFirst
       .Fields(0) = True
       .Update
       .Close
       Set RS = Nothing
    End With
    CN.CommitReans
    If MsgBox("The Book" & Text5.Text & "has been issued to " & Text4.Text & vbNewLine & "Do you want to create a new issue instance?", vbInformation + vbYesNo) = vbYes Then
       cmdReset_Click
    Else
       Unload Me
    End If
Exit Sub
hell:
    Handler Err
    CN.RollbackTrans
    
End Sub

Private Sub cmdReset_Click()
   Text1.Text = ""
   Text2.Text = ""
   Text5.Text = ""
   Text4.Text = ""
   Text3.Text = FormatDateTime$(Date, vbLongDate)
   Text6.Text = FormatDateTime$(Date + frmReturn.MaxDays, vbLongDate)
   
End Sub

Private Sub Form_Load()
   cmdReset_Click
   With frmmain
       cmdCode.Picture = .ImageList16.ListImages(1).Picture
       Me.Icon = .ImageList32.ListImages(7).Picture
    End With
    cmdBook.Picture = cmdCode.Picture  '可能出错
    Image1.Picture = Me.Icon
End Sub

Private Sub MDIForm_Load()

Me.Show
Set CN = New ADODB.Connection
CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;DATA Source=" & App.Path & "\MasterFile.mdb;Persist Security Info=False;"
If CN.State <> adStateOpen Then MsgBox "Could not establish a connection with the database" & vbNewLine & "The database should exist in ApplicationPath\MasterFile.mdb", vbExclamation, "database not found!": Unload Me
frmReturn.FineAmnt = CCur(GetSetting(App.Title, "Settings", "Fine Amount", "0.2"))
frmReturn.MaxDays = CInt(GetSetting(App.Title, "Settings", "Max Days", "14"))
End Sub

Private Sub MDIForm_UnLoad(Cancel As Integer)
Dim Form As Form
    For Each Form In Forms
      Unload Form
      Set Form = Nothing
    Next Form
    Set CN = Nothing
End Sub

Private Sub mnuAbout_Click()
    frmAbout.Show vbModal
End Sub


Private Sub mnuBookRec_Click()
  With FrmBooks
     .Show
     .SetFocus
    End With
End Sub

Private Sub mnuBookRep_Click()
  DataReport1.Show
End Sub





Private Sub mnuIssue_Click()
  frmIssue.Show vbModal
End Sub

Private Sub mnuMembers_Click()
   With frmMembers
      .Show
      .SetFocus
    End With
End Sub

Private Sub mnuReturn_Click()
   frmReturn.Show vbModal
End Sub

Private Sub mnuSettings_Click()
   frmSettings.Show vbModal
End Sub

Private Sub mnuTileHorizontal_Click(Index As Integer)
   frmmain.Arrange vbTileHorizontal
End Sub

Private Sub mnuTileVertical_Click(Index As Integer)
   frmmain.Arrange vbTileVertical
End Sub

Private Sub mnuExit_Click()
  Unload Me
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
   Select Case Button.Index
   Case 1: mnuIssue_Click
   Case 2: mnuReturn_Click
   Case 4: mnuBookRec_Click
   Case 5: mnuMembers_Click
   Case 6: PopupMenu mnuReports, , Toolbar1.Buttons(6).Left, Toolbar1.Top + Toolbar1.Height
   Case 8: mnuSettings_Click
   Case 9: mnuAbout_Click
   End Select
End Sub

Private Sub mnuArrangeIcons_Click(Index As Integer)
    frmmain.Arrange vbArrangeIcons
End Sub
Private Sub mnuCascade_Click(Index As Integer)
   frmmain.Arrange vbCascade
End Sub

Private Sub cmdAMod_Click(Index As Integer)
    On Error Resume Next
      With frmMembersAE
         .AddState = Index
         .OldID = RS.Fields
         If Index = 0 Then
           .txtCode.Text = RS(0)
           .txtName.Text = RS(1)
           .txtM.Text = RS(2)
           .cmbSection = RS(3)
           frmMembersAE.cmdAddSave.Caption = "修改"
        End If
           .Show vbModal
        End With
        cmdRefresh_Click
        DisplayRecords
End Sub

Private Sub cmdClose_Click()
   Unload Me
End Sub

Private Sub cmdDelete_Click()
    On Error GoTo hell
    With RS
       If .RecordCount < 1 Then MsgBox "没有记录可以删除", vbExclamation: Exit Sub
       Dim ans As Integer, pos As Integer
       ans = MsgBox("你确定删除这一条记录吗？？", vbCritical + vbYesNo, "确认删除记录")
       Screen.MousePointer = vbHourglass
       If ans = vbYes Then
       pos = .AbsolutePosition
       CN.BeginTrans
       .Delete
       .Requery
       CN.CommitTrans
       If pos > .RecordCount Then
          If Not .EOF Or .BOF Then .MoveFirst
        Else
           .AbsolutePosition = pos
        End If
          MsgBox "已经成功删除记录", vbInformation, "确认"
        End If
        Screen.MousePointer = vbDefault
    End With
Exit Sub
hell:
    Handler Err
    CN.RollbackTrans
End Sub

Private Sub cmdOperations_Click(Index As Integer)
Dim obj As Form
    If Index = 0 Then Set obj = frmSearch
    If Index = 1 Then Set obj = FrmFilter
    If Index = 2 Then Set obj = frmSort
    With obj
       Set .SourceRS = RS
       .Show vbModal
    End With
    Set obj = Nothing
End Sub

Private Sub cmdRefresh_Click()
   With RS
      .Filter = adFilterNone
      .Requery
   End With
End Sub

Private Sub cmdRetrive_Click()
Dim tmpRS As New ADODB.Recordset
   With tmpRS
      .Open "SELECT [Picture] FROM tblMembers WHERE [学生编号]= '" & txtDisp(0).Text & " ' ", CN, adOpenForwardOnly, adLockOptimistic
      If Len(RS!Picture) > 0 Then
         picBox.loadphoto RS!Picture
      Else
         Set picBox.Picture = LoadPicture
      End If
      .Close
    End With
    Set tmpRS = Nothing
End Sub



Private Sub DataGrid1_KeyUp(KeyCode As Integer, Shift As Integer)
   If KeyCode = 38 Or KeyCode = 40 Then DisplayRecords
End Sub


Private Sub Form_Load()
    On Error GoTo hell
    Set RS = New ADODB.Recordset
    RS.CursorLocation = adUseClient
    RS.Open "SELECT * FROM tblMembers", CN, adOpenDynamic, adLockOptimistic
    Set DataGrid1.DataSource = RS
    DisplayRecords
    With frmmain.ImageList32
        cmdReport(0).Picture = .ListImages(6).Picture
        cmdReport(1).Picture = .ListImages(6).Picture
    End With
Exit Sub
hell:
    Handler Err
    Resume Next
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set RS = Nothing
    Set frmMembers = Nothing
    
End Sub
Private Sub DisplayRecords()
Dim i As Integer
   On Error Resume Next
     With RS
        If .RecordCount < 1 Then
        txtcount.Text = 0
    Else
        txtcount.Text = .AbsolutePosition
    End If
    lblmac.Caption = .RecordCount
    For i = 0 To 6
       txtDisp(i).Text = .Fields(i)
    Next i
End With
End Sub
Private Sub cmdNavigate_Click(Index As Integer)
   Navigate Index, RS
   DisplayRecords

End Sub

Private Sub cmdCode_Click()
Dim RS As ADODB.Recordset, i As Integer
    On Error Resume Next
       With frmSelectDg
          .CommandText = "SELECT tblTrans.[图书编号],tblTran.[学生编号],tblBooks.图书标题,[姓名] & ' ' & [性别] As 借书人, tblTrans.[借书日期] From tblMembers INNER Join (tblBooks INNER Join tblTrans ON tblBooks.[图书编号]=tblTrans.[图书编号] ) ON tblMembers.[学生编号]=tblTrans.[学生编号] Where (((tblTrans.是否归还)=False)) ORDER by tblTrans.[图书编号];"
          .DataGrid1.Caption = "借书信息"
          .Show vbModal
          If .OKPressed Then
             Text4.Text = .rRS1
             Text1.Text = .rRS2
             txtFines.Locked = False
        Else
           Exit Sub
        End If
    End With
    Set RS = New ADODB.Recordset
    RS.Open "Select * From tblTrans Where [图书编号] ='" & Text4.Text & "'", CN, adOpenDynamic, adLockOptimistic
    lblDate.Caption = CDate(RS(2))
    i = Date - CDate(lblDate.Caption)
    If i < 0 Then i = 0
    If MaxDays < i Then lblLate.Caption = i - MaxDays Else lblLate.Caption = "0"
    lblFines.Caption = CStr(FormatCurrency$(FineAmnt * lblLate))
    txtFines.Text = lblFines.Caption
    Set RS = Nothing
End Sub

Private Sub cmdReset_Click()
     lblLate.Caption = "请选择一本书"
     lblFines.Caption = "请选择一本书"
     lblDate.Caption = "请选择一本书"
     txtFines.Text = ""
     txtFines.Locked = True
     Text1.Text = ""
     Text4.Text = ""
     Text2.Text = FormatDateTime$(Date, vbLongDate)
     
End Sub

Private Sub cmdReturn_Click()
Dim RS As ADODB.Recordset
    If Text4.Text = "" Then Text4.SetFocus
    On Error GoTo hell
    Set RS = New ADODB.Recordset
    With RS
        CN.BeginTrans
        .Open "Select [是否出错] From tblBooks Where [图书编号]='" & Text4.Text & "'", CN, adOpenDynamic, adLockOptimistic
        .MoveFirst
        .Fields(0) = False
        .Update
        .Close
        .Open "Select [罚款],[是否归还] From tblTrans where [图书编号]='" & Text4.Text & "'" & "And [是否归还]=False", CN, adOpenDynamic, adLockOptimistic
        .MoveFirst
        .Fields("罚款") = CCur(txtFines.Text)
        .Fields("是否归还") = True
        .Update
        .Close
        CN.CommitTrans
    End With
    Set RS = Nothing
    If MsgBox("这本书" & Text4.Text & "已经归还" & Text1.Text & vbNewLine & vbNewLine & "您是否要创建一条归还图书记录？？", vbInformation + vbYesNo) = vbYes Then
      cmdReset_Click
    Else
      Unload Me
    End If
Exit Sub
hell:
    Handler Err
    On Error Resume Next
       CN.RollbackTrans


End Sub

Private Sub Command4_Click()
   On Error GoTo hell
   Shell "calc.exe", vbNormalFocus
Exit Sub
hell:
   MsgBox "The operating system cannot find the system calculator." & vbNewLine & "Please check whether in is properly installed or not", vbCritical, "File not found"
   
End Sub

Private Sub Form_Load()
   Me.Icon = frmmain.ImageList32.ListImages(8).Picture
   Image1.Picture = Me.Icon
   cmdReset_Click
   cmdCode.Picture = frmmain.ImageList16.ListImages(1).Picture
End Sub

Private Sub cmdClose_Click()
  Unload Me
End Sub
Private Sub cmdNavigate_Click(Index As Integer)
  Navigate Index, RS
  DisplayRecords
End Sub

Private Sub cmdOperations_Click(Index As Integer)
Dim obj As Form
    If Index = 1 Then Set obj = frmSearch
    If Index = 0 Then Set obj = FrmFilter
    If Index = 2 Then Set obj = frmSort
    With obj
        Set .SourceRS = RS
        .Show vbModal
    End With
    Set obj = Nothing
End Sub

Private Sub cmdRefresh_Click()
   With RS
      .Filter = adFilterNone
      .Requery
    End With
End Sub

Private Sub cmdSelect_Click()
   On Error Resume Next
     With RS
        If .RecordCount < 1 Then MsgBox "No record to select!" & vbNewLine & "Please add records to the library first to select data from them.", vbExclamation, "No data Selected": Exit Sub
        rRS1 = .Fields(0)
        rRS2 = .Fields(1)
        rRS3 = .Fields(2)
        rRS4 = .Fields(3)
    End With
    CommangText = ""
    OKPressed = True
    Unload Me
End Sub

Private Sub Form_Load()
Dim RS As ADODB.Recordset
    Set RS = New ADODB.Recordset
    RS.CursorLocation = adUseClient
    RS.Open CommandText, CN, adOpenDynamic, adLockOptimistic
    DisplayRecords
    Me.Icon = cmdSelect.Picture
    Set DataGrid1.DataSource = RS
    OKPressed = False
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
   Set RS = Nothing
End Sub
Private Sub DisplayRecords()
   On Error GoTo hell
   With RS
      If .RecordCount < 1 Then
         txtcount.Text = 0
        Else
          txtcount.Text = .AbsulotePosition
        End If
        lblmax.Caption = .RecordCount
    End With
Exit Sub
hell:
   Handler Err
End Sub