hi all of you,
I have a problem. When I using vb6.0 to connect
access 97 . I found the following error message
在此集合,找不到此項目
the following is part of the codes
Option Explicit
Const ROWNum = 50
Const COLNum = 3
Const HIGH = 350
Const KEYEnter = 13
Const GRIDCol_0 = 0
Const GRIDCol_1 = 1
Const GRIDCol_2 = 2

Dim RowTop, RowDown As Integer
Dim MouseMove As Boolean
Dim Modify(ROWNum - 1) As Integer
Dim Grid(ROWNum - 1, COLNum)
Dim AddRecord, ModifyRecord As Boolean
Private Sub Command1_Click()
On Error GoTo AddError
ClearHead
MSFlexGrid1.Clear
SetgridHead
ClearGrid
Text1(0).SetFocus
AddRecord = True
SaveCancel
Exit Sub
AddError:
MsgBox Err.Description
End Sub


Private Sub Command10_Click()
On Error GoTo NextError
rs1.MoveNext
If rs1.EOF Then
rs1.MoveLast
Beep
MsgBox "這已是最后一條記錄了", vbOKOnly + vbExclamation, ""
Exit Sub
End If
DisplayDataRs1
DisplayDataRs2
Exit Sub
NextError:
MsgBox Err.Description
End Sub
Private Sub Command11_Click()
On Error GoTo LastError
rs1.MoveLast
DisplayDataRs1
DisplayDataRs2
Exit Sub
LastError:
MsgBox Err.Description
End Sub




Private Sub Command2_Click()
Dim i As Integer
On Error GoTo ModError
Text1(0).SetFocus
For i = 1 To ROWNum - 1
Modify(i) = 0
Next
ModifyRecord = True
SaveCancel
Exit Sub
ModError:
MsgBox Err.Description
End Sub













Private Sub Command3_Click()
Dim DelRecord, i, tmp As Integer
Dim sql As String
On Error GoTo DelError
DelRecord = MsgBox("你真的要刪除這些記錄嗎?", vbQuestion + vbYesNo, "刪除記錄")
If DelRecord = vbYes Then
sql = InputBox$("如要刪除介面上的所有資料請按[0],刪除所選資料請按[1]", "刪除資料")
Else
Exit Sub
End If
If sql = "0" Then
BeginTrans
rs1.Delete
CommitTrans
rs1.MoveNext
If rs1.RecordCount > 0 Then
   If rs1.EOF Then
   rs1.MoveLast
   End If
   DisplayDataRs1
   DisplayDataRs2
  Else
   rs1.AddNew
   ClearHead
   MSFlexGrid1.Clear
   SetgridHead
   InitialButton
  End If
ElseIf sql = "1" Then
On Error GoTo cmdDelError
If RowTop > RowDown Then
  tmp = RowTop
  RowTop = RowDown
  RowDown = tmp
  End If
 
  BeginTrans
  For i = RowTop To RowDown
   If Grid(i, 0) <> "" Then
   sql = "delete from 借書副表.圖書編號=" & "'" & Grid(i, 0) & "'" & "and 借書副表.借書序號=" & "'" & Text1(0) & "'"
   
   db.Execute sql
   End If
  Next
  CommitTrans
 
  On Error GoTo DelError
 
  DisplayDataRs2
End If
  Exit Sub
DelError:
MsgBox Err.Description
Exit Sub
cmdDelError:
Rollback
MsgBox Err.Description


End Sub
Private Sub Command4_Click()
Dim i As Integer
On Error GoTo SaveError
If Text1(0) = "" Or Text1(1) = "" Then
MsgBox "借書序號和員工編號不能為空", vbOKOnly + vbExclamation, ""
If Text1(0) = "" Then
 Text1(0).SetFocus
 ElseIf Text1(1) = "" Then
 Text1(1).SetFocus
 End If
ElseIf AddRecord = True Then
On Error GoTo SaveAddModError
BeginTrans
rs1.AddNew
WriteRecordRs1
rs1.Update
For i = 0 To ROWNum - 1
If Grid(i, 0) <> "" Then
  rs2.AddNew
  WriteRecordRs2 i
  rs2.Update
  End If
Next
CommitTrans
LookupRecord
AddRecord = False
Text2.Visible = False
List1.Visible = False
InitialButton
ElseIf ModifyRecord = True Then
On Error GoTo SaveAddModError
BeginTrans
rs1.Edit
WriteRecordRs1
rs1.Update
rs2.MoveFirst
For i = 1 To rs2.RecordCount
If Modify(i) = 1 And Grid(i, GRIDCol_0) <> "" Then
  rs2.Edit
  WriteRecordRs2 i
  rs2.Update
  End If
  rs2.MoveNext
Next
For i = rs2.RecordCount + 1 To ROWNum - 1
If Grid(i, GRIDCol_0) <> "" Then
  rs2.AddNew
  WriteRecordRs2 i
  rs2.Update
  End If
Next
CommitTrans
LookupRecord
ModifyRecord = False
Text2.Visible = False
List1.Visible = False
InitialButton
End If
Exit Sub
SaveError:
MsgBox Err.Description
Exit Sub
SaveAddModError:
Rollback
MsgBox Err.Description
End Sub
Private Sub Command5_Click()
On Error GoTo CancelError
If rs1.RecordCount > 0 Then
DisplayDataRs1
DisplayDataRs2
Else
ClearHead
MSFlexGrid1.Clear
SetgridHead
End If
AddRecord = False
ModifyRecord = False
List1.Visible = False
Text2.Visible = False
InitialButton
Exit Sub
CancelError:
MsgBox Err.Description
End Sub
Private Sub Command6_Click()
On Error GoTo QuitError
frmManager.Enabled = True
Unload frmLend
Exit Sub
QuitError:
MsgBox Err.Description
End Sub
Private Sub Command7_Click()
Dim num As String
On Error GoTo FindError
num = InputBox$("請輸入借書序號", "借書序號尋找", "")
If num <> "" Then
num = "借書序號=" & "'" & num & "'"
rs1.FindFirst num
If Not rs1.NoMatch Then
  DisplayDataRs1
  DisplayDataRs2
  Else
  MsgBox "對不起,沒有所要找的資訊!", vbOKOnly + vbExclamation, ""
  End If
End If
Exit Sub
FindError:
MsgBox Err.Description
End Sub
Private Sub Command8_Click()
On Error GoTo FirstError
rs1.MoveFirst
DisplayDataRs1
DisplayDataRs2
Exit Sub
FirstError:
MsgBox Err.Description
End Sub
Private Sub Command9_Click()
On Error GoTo PreError
rs1.MovePrevious
If rs1.BOF Then
rs1.MoveFirst
Beep
MsgBox "這已是第一條記錄了", vbOKOnly + vbExclamation, ""
Exit Sub
End If
DisplayDataRs1
DisplayDataRs2
Exit Sub
PreError:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
Dim sql As String
On Error GoTo LoadError
sql = "select 員工.* from 員工 order by 員工.員工編號"
Set rs4 = db.OpenRecordset(sql, dbOpenDynaset)
If rs4.RecordCount = 0 Then
Beep
MsgBox "沒有員工資料,無法借書", vbCritical + vbOKOnly, ""
Exit Sub
End If
sql = "select 圖書.* from 圖書 order by 圖書.圖書編號"
Set rs3 = db.OpenRecordset(sql, dbOpenDynaset)
If rs3.RecordCount = 0 Then
Beep
MsgBox "沒有圖書資料,無法借書", vbCritical + vbOKOnly, ""
Exit Sub
End If

DisplayList1
sql = "select 借書主表.*,員工.名字 from 借書主表 inner join 員工 on 借書主表.員工編號=員工.員工編號 order by 借書主表.借書序號"
Set rs1 = db.OpenRecordset(sql, dbOpenDynaset)
ClearHead
Setgrid
SetgridHead
If rs1.RecordCount > 0 Then
DisplayDataRs1
DisplayDataRs2
Else
MsgBox "沒有任何的借書資訊", vbOKOnly + vbExclamation, ""
sql = "select 借書副表.*,圖書.圖書名稱,圖書.購書日期 from (借書副表 inner join 借書主表 on 借書副表.借書序號=借書主表.借書序號) inner join 圖書 on 圖書.圖書編號=借書副表.圖書編號) order by 借書副表.圖書編號"
Set rs2 = db.OpenRecordset(sql, dbOpenDynaset)
ClearGrid
End If
AddRecord = False
ModifyRecord = False
InitialButton
Exit Sub
LoadError:
MsgBox Err.Description

End Sub









Public Sub ClearHead()
Dim i As Integer
On Error GoTo ClearError
For i = 0 To 3
Text1(i).Text = ""
Next
Exit Sub
ClearError:
MsgBox Err.Description
End Sub





Public Sub Setgrid()
On Error GoTo SetError
Dim i As Integer
MSFlexGrid1.ScrollBars = flexScrollBarVertical
MSFlexGrid1.FixedCols = 0
MSFlexGrid1.Rows = ROWNum
MSFlexGrid1.Cols = COLNum
For i = 0 To ROWNum - 1
MSFlexGrid1.RowHeight(i) = HIGH
Next
MSFlexGrid1.ColWidth(0) = 1000
MSFlexGrid1.ColWidth(1) = 2500
MSFlexGrid1.ColWidth(2) = 1000
Exit Sub
SetError:
MsgBox Err.Description
End Sub


Public Sub SetgridHead()
On Error GoTo SetError

MSFlexGrid1.Row = 0
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = "圖書編號"
MSFlexGrid1.Col = 1
MSFlexGrid1.Text = "圖書名稱"
MSFlexGrid1.Col = 2
MSFlexGrid1.Text = "購書日期"

Exit Sub
SetError:
MsgBox Err.Description
End Sub

Public Sub ClearGrid()
Dim i, j As Integer
For i = 1 To ROWNum - 1
For j = 0 To COLNum - 1
  Grid(i, j) = ""
  Next
Next
End Sub

Public Sub DisplayDataRs1()
If Not IsNull(rs1![借書序號]) Then Text1(0) = rs1![借書序號] Else Text1(0) = ""
If Not IsNull(rs1![員工編號]) Then Text1(1) = rs1![員工編號] Else Text1(1) = ""
If Not IsNull(rs1![名字]) Then Text1(2) = rs1![名字] Else Text1(2) = ""
If Not IsNull(rs1![借書日期]) Then Text1(3) = rs1![借書日期] Else Text1(3) = ""
End Sub


Public Sub DisplayDataRs2()
Dim Gridrow As Integer
Dim sql As String
On Error GoTo DisplayError
sql = "select 借書副表.*,圖書.圖書名稱,圖書.購書日期 from (借書副表 inner join 借書主表 on 借書副表.借書序號=借書主表.借書序號)inner join 圖書 on 圖書.圖書編號=借書副表.圖書編號 where 借書副表.借書序號=" & "'" & rs1![借書序號] & "'" & " order by 借書副表.圖書編號"
Set rs2 = db.OpenRecordset(sql, dbOpenDynaset)
ClearGrid
MSFlexGrid1.Clear
SetgridHead

If rs2.RecordCount = 0 Then
rs2.AddNew
Exit Sub
End If
Gridrow = 0
Do Until rs2.EOF
Gridrow = Gridrow + 1
MSFlexGrid1.Row = Gridrow
MSFlexGrid1.Col = 0
If Not IsNull(rs2![圖書編號]) Then MSFlexGrid1.Text = rs2![圖書編號] Else MSFlexGrid1.Text = ""
MSFlexGrid1.Col = 1
If Not IsNull(rs2![圖書名稱]) Then MSFlexGrid1.Text = rs2![圖書名稱] Else MSFlexGrid1.Text = ""
MSFlexGrid1.Col = 2
If Not IsNull(rs2![購書日期]) Then MSFlexGrid1.Text = rs2![購書日期] Else MSFlexGrid1.Text = ""
rs2.MoveNext
Loop
MSFlexGrid1.TopRow = 1
Exit Sub
DisplayError:
MsgBox Err.Description
End Sub
Private Sub List1_DblClick()
On Error GoTo ListError
getdata = List1.List(List1.ListIndex)
Text2.SetFocus
Exit Sub
ListError:
MsgBox Err.Description
End Sub
Private Sub MSFlexGrid1_Click()
If (AddRecord = True Or ModifyRecord = True) And MSFlexGrid1.Col = GRIDCol_0 Then
NextPosition MSFlexGrid1.Row, MSFlexGrid1.Col
End If
End Sub

Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseMove = False
End Sub
Private Sub MSFlexGrid1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseMove = True
End Sub
Private Sub MSFlexGrid1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If MouseMove = True Then
RowTop = MSFlexGrid1.Row
RowDown = MSFlexGrid1.RowSel
Else
RowTop = 0
RowDown = 0
End If
End Sub
Private Sub MSFlexGrid1_Scroll()
Text2.Visible = False
List1.Visible = False
End Sub




Private Sub Text1_GotFocus(Index As Integer)
On Error GoTo TextError
If AddRecord = True Or ModifyRecord = True Then Text1(Index).BackColor = RGB(255, 255, 0)
Text2.Visible = False
If AddRecord = False And ModifyRecord = False Then
Beep
MsgBox "請先點按[新增]或[取消]功能按鈕", vbOKOnly + vbExclamation, ""
ElseIf AddRecord = True And Index = 3 Then
Text1(Index) = Date
End If
Exit Sub
TextError:
MsgBox Err.Description
End Sub
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
Dim s As String
On Error GoTo TextError
If KeyAscii = KEYEnter Then
If Index <> 3 Then
   If Index = 1 Then
     s = "員工編號=" & "'" & Text1(1) & "'"
     rs4.FindFirst s
     If Not rs4.NoMatch Then
       If Not IsNull(rs4![名字]) Then Text1(2) = rs4![名字] Else Text1(2) = ""
     Else
     Beep
     MsgBox "沒有此員工編號,請重新輸入", vbExclamation + vbOKOnly, ""
     Text1(1) = ""
     Exit Sub
     End If
   End If
   Text1(Index + 1).SetFocus
  Else
   MSFlexGrid1.Row = 1
   MSFlexGrid1.Col = 0
   NextPosition MSFlexGrid1.Row, MSFlexGrid1.Col
  End If
KeyAscii = 0
End If
Exit Sub
TextError:
MsgBox Err.Description

End Sub
Private Sub Text1_LostFocus(Index As Integer)
Text1(Index).BackColor = RGB(255, 255, 255)
End Sub











Public Sub NextPosition(ByVal r As Integer, ByVal c As Integer)
On Error GoTo NextError
Text2.Width = MSFlexGrid1.CellWidth
Text2.Height = MSFlexGrid1.CellHeight
Text2.Left = MSFlexGrid1.Left + MSFlexGrid1.ColPos(c) + 50
Text2.Top = MSFlexGrid1.Top + MSFlexGrid1.RowPos(r) + 50
Text2.Text = MSFlexGrid1.Text
Text2.Visible = True
Text2.SetFocus
Exit Sub
NextError:
MsgBox Err.Description
End Sub












Private Sub Text2_Click()
On Error GoTo TextError
Grid(MSFlexGrid1.Row, MSFlexGrid1.Col) = Text2.Text
If ModifyRecord = True Then
Modify(MSFlexGrid1.Row) = 1
End If
Exit Sub
TextError:
MsgBox Err.Description
End Sub
Private Sub Text2_GotFocus()
If getdata = "" And (AddRecord = True Or ModifyRecord = True) And MSFlexGrid1.Col = GRIDCol_0 Then
List1.Visible = True
List1.SetFocus
ElseIf getdata <> "" And (AddRecord = True Or ModifyRecord = True) And MSFlexGrid1.Col = GRIDCol_0 Then
List1.Visible = False
Text2.Text = Left(getdata, 4)
MSFlexGrid1.Text = Text2.Text
MSFlexGrid1.Col = GRIDCol_1
MSFlexGrid1.Text = Mid(getdata, 6, Len(getdata) - 14)
MSFlexGrid1.Col = GRIDCol_2
MSFlexGrid1.Text = Right(getdata, 8)

getdata = ""
Text2.Visible = False
End If
End Sub
Public Sub DisplayList1()
On Error GoTo LookupError
List1.Clear
rs3.MoveFirst
Do While Not rs3.EOF
List1.AddItem rs3![圖書編號] & "," & rs3![圖書名稱] & "," & rs3![購書日期]
rs3.MoveNext
Loop
If List1.ListCount > 0 Then
List1.ListIndex = 0
End If
Exit Sub
LookupError:
MsgBox Err.Description
End Sub

Public Sub LookupRecord()
On Error GoTo LookupError
rs1.Requery
getdata = "'" & RTrim(Text1(0)) & "'"
getdata = "借書序號=" & getdata
rs1.FindFirst getdata
getdata = ""
Exit Sub
LookupError:
MsgBox Err.Description
End Sub












Public Sub WriteRecordRs1()
rs1![借書序號] = RTrim(Text1(0))
rs1![員工編號] = UCase(Text1(1))
rs1![借書日期] = Text1(3)
End Sub


Public Sub WriteRecordRs2(r As Integer)
rs2![借書序號] = Text1(0)
MSFlexGrid1.Row = r
MSFlexGrid1.Col = GRIDCol_0
If MSFlexGrid1.Text <> "" Then rs2![圖書編號] = MSFlexGrid1.Text Else rs2![圖書編號] = Null
End Sub


Public Sub InitialButton() '初始化各按鈕可用狀態
Dim i As Integer
If rs1.RecordCount > 0 Then
Command1.Enabled = True
  Command2.Enabled = True
  Command3.Enabled = True
  Command4.Enabled = False
  Command5.Enabled = False
  Command6.Enabled = True
 
  Command7.Enabled = True
 
  Command8.Enabled = True
  Command9.Enabled = True
  Command10.Enabled = True
  Command11.Enabled = True
Else
Command1.Enabled = True
  Command2.Enabled = False
  Command3.Enabled = False
  Command4.Enabled = False
  Command5.Enabled = False
  Command6.Enabled = True
 
  Command7.Enabled = False
 
  Command8.Enabled = False
  Command9.Enabled = False
  Command10.Enabled = False
  Command11.Enabled = False
End If
End Sub



Public Sub SaveCancel()
Dim i As Integer
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = True
Command5.Enabled = True
Command6.Enabled = False

Command7.Enabled = False
Command8.Enabled = False
Command9.Enabled = False
Command10.Enabled = False
Command11.Enabled = False
End Sub
創作者介紹
創作者 vbqa 的頭像
vbqa

小吳 VBQA 程式設計討論

vbqa 發表在 痞客邦 留言(0) 人氣()