haplo
23-01-2003, 04:11 PM
hallo helpen.be forum
kan u mij helpen om de code die hiervolgt (voor invoer in access 97) te veranderen zodat deze werkt met een database van 2000.
thankx,
Private Sub add_names()
TutRS.MoveLast
X = TutRS.RecordCount
If X = 0 Then Exit Sub
TutRS.MoveFirst
Do
List1.AddItem TutRS!Name
Y = Y + 1: TutRS.MoveNext
Loop Until Y = X ' X = last record remember.
End Sub
Private Sub Command1_Click(Index As Integer)
Select Case (Index)
Case 0 ' Add New
For i = 0 To 1
db_show(i).Text = ""
Next i
Command1(1).Enabled = False
Command1(2).Caption = "&Cancel"
List1.Enabled = False
db_show(0).SetFocus
save_but.Visible = True
Command1(0).Visible = False
Command1(1).Enabled = False
Exit Sub
Case 1 ' Update
On Error GoTo do_errors
TutRS.Edit
TutRS!Name = db_show(0).Text
TutRS!Address = db_show(1).Text
TutRS.Update
List1.Clear
add_names
Command1(0).Enabled = True
Command1(2).Caption = "&Remove"
Command1(1).Enabled = False
Exit Sub
do_errors:
Select Case (Err)
Case 3021
For i = 0 To 1
db_show(i).Text = ""
Next i
Command1(2).Caption = "&Remove"
Command1(0).Enabled = True
Command1(1).Enabled = False
If Not List1.ListCount = 0 Then
List1.Selected(0) = False
List1.Selected(0) = True
End If
save_but.Visible = False
Command1(0).Visible = True
Exit Sub
End Select
Case 2 ' Remove
If Command1(2).Caption = "&Cancel" Then
X = List1.ListIndex
For i = 0 To 1
db_show(i).Text = ""
Next i
List1.Enabled = True
Command1(2).Caption = "&Remove"
Command1(0).Enabled = True
Command1(1).Enabled = False
If Not List1.ListCount = 0 Then
List1.Selected(0) = False
List1.Selected(0) = True
End If
save_but.Visible = False
Command1(0).Visible = True
Exit Sub
End If
If Command1(2).Caption = "&Remove" Then
Dim Criteria As String
If List1.ListCount = 0 Then Exit Sub
Criteria = "Name = '" & db_show(0).Text & "'"
TutRS.MoveFirst
TutRS.FindFirst Criteria
TutRS.Delete
List1.Clear
For i = 0 To 1
db_show(i).Text = ""
Next i
Command1(1).Enabled = False
add_names
record_count.Caption = record_count.Caption - 1
Exit Sub
End If
End Select
End Sub
Private Sub Command2_Click()
' Guess what this does ;)
End
End Sub
Private Sub db_show_GotFocus(Index As Integer)
' This highlights the contents of the text box.
db_show(Index).SelStart = 0
db_show(Index).SelLength = Len(db_show(Index))
End Sub
Private Sub db_show_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Command1(0).Enabled = False
If save_but.Caption = "&Save New" And Command1(0).Visible = False Then
Command1(1).Enabled = False
End If
If Command1(0).Visible = True Then
Command1(1).Enabled = True
End If
Command1(2).Caption = "&Cancel"
End Sub
Private Sub Form_Load()
' This sets the path of the filename.
' The app.path statement is VERY useful as it
' returns the directory where the program is installed
' wherever it is on your PC.
dbname = App.Path & "\VB4Tut.mdb"
' Set the Database to point to runners.mdb.
Set TutVB4DB = DBEngine.Workspaces(0).OpenDatabase(dbname)
' Open the table I created called Runners.
Set TutRS = TutVB4DB.OpenRecordset("Runners", dbOpenDynaset)
' For some strange reason, VB4 won't return
' an accurate record count unless you first move
' the database pointer to the last record in the db.
On Error GoTo process_err
TutRS.MoveLast
X = TutRS.RecordCount
Form1.record_count.Caption = X
' Now lets put the names into the Listbox.
TutRS.MoveLast
X = TutRS.RecordCount
TutRS.MoveFirst
Do
List1.AddItem TutRS!Name
Y = Y + 1: TutRS.MoveNext
Loop Until Y = X ' X = last record remember.
process_err:
Select Case (Err)
Case 3021 ' No current record
record_count = 0
Exit Sub
End Select
End Sub
Private Sub Form_Paint()
' Set the first item to be selected in the listbox.
' Note, count starts at 0 rather than 1.
If List1.ListCount = 0 Then GoTo db_empty
List1.Selected(0) = True
db_empty:
Command1(0).Enabled = True
Command1(2).Caption = "&Remove"
End Sub
Private Sub List1_Click()
Dim Criteria As String
X = List1.ListIndex ' Get the item number selected
temp_dt$ = List1.List(X) ' Get the text selected
temp_dtr$ = Trim$(temp_dt$) ' Make sure no additional characters have crept in.
Criteria = "Name = '" & temp_dtr$ & "'" ' Set the criteria to the name selected.
TutRS.FindFirst Criteria ' Find the first occurence.
db_show(0).Text = temp_dtr$
db_show(1).Text = TutRS!Address
End Sub
Private Sub save_but_Click()
' This is just repetetive code to save the new name and address
' to the database.
If db_show(0).Text = "" Then Exit Sub
If db_show(1).Text = "" Then Exit Sub
TutRS.AddNew
TutRS!Name = db_show(0).Text
TutRS!Address = db_show(1).Text
TutRS.Update
List1.Clear
List1.Enabled = True
Command1(2).Caption = "&Remove"
Command1(0).Enabled = True
save_but.Visible = False
Command1(0).Visible = True
TutRS.MoveLast
X = TutRS.RecordCount
TutRS.MoveFirst
Do
List1.AddItem TutRS!Name
Y = Y + 1: TutRS.MoveNext
Loop Until Y = X ' X = last record remember.
record_count.Caption = record_count.Caption + 1
End Sub
kan u mij helpen om de code die hiervolgt (voor invoer in access 97) te veranderen zodat deze werkt met een database van 2000.
thankx,
Private Sub add_names()
TutRS.MoveLast
X = TutRS.RecordCount
If X = 0 Then Exit Sub
TutRS.MoveFirst
Do
List1.AddItem TutRS!Name
Y = Y + 1: TutRS.MoveNext
Loop Until Y = X ' X = last record remember.
End Sub
Private Sub Command1_Click(Index As Integer)
Select Case (Index)
Case 0 ' Add New
For i = 0 To 1
db_show(i).Text = ""
Next i
Command1(1).Enabled = False
Command1(2).Caption = "&Cancel"
List1.Enabled = False
db_show(0).SetFocus
save_but.Visible = True
Command1(0).Visible = False
Command1(1).Enabled = False
Exit Sub
Case 1 ' Update
On Error GoTo do_errors
TutRS.Edit
TutRS!Name = db_show(0).Text
TutRS!Address = db_show(1).Text
TutRS.Update
List1.Clear
add_names
Command1(0).Enabled = True
Command1(2).Caption = "&Remove"
Command1(1).Enabled = False
Exit Sub
do_errors:
Select Case (Err)
Case 3021
For i = 0 To 1
db_show(i).Text = ""
Next i
Command1(2).Caption = "&Remove"
Command1(0).Enabled = True
Command1(1).Enabled = False
If Not List1.ListCount = 0 Then
List1.Selected(0) = False
List1.Selected(0) = True
End If
save_but.Visible = False
Command1(0).Visible = True
Exit Sub
End Select
Case 2 ' Remove
If Command1(2).Caption = "&Cancel" Then
X = List1.ListIndex
For i = 0 To 1
db_show(i).Text = ""
Next i
List1.Enabled = True
Command1(2).Caption = "&Remove"
Command1(0).Enabled = True
Command1(1).Enabled = False
If Not List1.ListCount = 0 Then
List1.Selected(0) = False
List1.Selected(0) = True
End If
save_but.Visible = False
Command1(0).Visible = True
Exit Sub
End If
If Command1(2).Caption = "&Remove" Then
Dim Criteria As String
If List1.ListCount = 0 Then Exit Sub
Criteria = "Name = '" & db_show(0).Text & "'"
TutRS.MoveFirst
TutRS.FindFirst Criteria
TutRS.Delete
List1.Clear
For i = 0 To 1
db_show(i).Text = ""
Next i
Command1(1).Enabled = False
add_names
record_count.Caption = record_count.Caption - 1
Exit Sub
End If
End Select
End Sub
Private Sub Command2_Click()
' Guess what this does ;)
End
End Sub
Private Sub db_show_GotFocus(Index As Integer)
' This highlights the contents of the text box.
db_show(Index).SelStart = 0
db_show(Index).SelLength = Len(db_show(Index))
End Sub
Private Sub db_show_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Command1(0).Enabled = False
If save_but.Caption = "&Save New" And Command1(0).Visible = False Then
Command1(1).Enabled = False
End If
If Command1(0).Visible = True Then
Command1(1).Enabled = True
End If
Command1(2).Caption = "&Cancel"
End Sub
Private Sub Form_Load()
' This sets the path of the filename.
' The app.path statement is VERY useful as it
' returns the directory where the program is installed
' wherever it is on your PC.
dbname = App.Path & "\VB4Tut.mdb"
' Set the Database to point to runners.mdb.
Set TutVB4DB = DBEngine.Workspaces(0).OpenDatabase(dbname)
' Open the table I created called Runners.
Set TutRS = TutVB4DB.OpenRecordset("Runners", dbOpenDynaset)
' For some strange reason, VB4 won't return
' an accurate record count unless you first move
' the database pointer to the last record in the db.
On Error GoTo process_err
TutRS.MoveLast
X = TutRS.RecordCount
Form1.record_count.Caption = X
' Now lets put the names into the Listbox.
TutRS.MoveLast
X = TutRS.RecordCount
TutRS.MoveFirst
Do
List1.AddItem TutRS!Name
Y = Y + 1: TutRS.MoveNext
Loop Until Y = X ' X = last record remember.
process_err:
Select Case (Err)
Case 3021 ' No current record
record_count = 0
Exit Sub
End Select
End Sub
Private Sub Form_Paint()
' Set the first item to be selected in the listbox.
' Note, count starts at 0 rather than 1.
If List1.ListCount = 0 Then GoTo db_empty
List1.Selected(0) = True
db_empty:
Command1(0).Enabled = True
Command1(2).Caption = "&Remove"
End Sub
Private Sub List1_Click()
Dim Criteria As String
X = List1.ListIndex ' Get the item number selected
temp_dt$ = List1.List(X) ' Get the text selected
temp_dtr$ = Trim$(temp_dt$) ' Make sure no additional characters have crept in.
Criteria = "Name = '" & temp_dtr$ & "'" ' Set the criteria to the name selected.
TutRS.FindFirst Criteria ' Find the first occurence.
db_show(0).Text = temp_dtr$
db_show(1).Text = TutRS!Address
End Sub
Private Sub save_but_Click()
' This is just repetetive code to save the new name and address
' to the database.
If db_show(0).Text = "" Then Exit Sub
If db_show(1).Text = "" Then Exit Sub
TutRS.AddNew
TutRS!Name = db_show(0).Text
TutRS!Address = db_show(1).Text
TutRS.Update
List1.Clear
List1.Enabled = True
Command1(2).Caption = "&Remove"
Command1(0).Enabled = True
save_but.Visible = False
Command1(0).Visible = True
TutRS.MoveLast
X = TutRS.RecordCount
TutRS.MoveFirst
Do
List1.AddItem TutRS!Name
Y = Y + 1: TutRS.MoveNext
Loop Until Y = X ' X = last record remember.
record_count.Caption = record_count.Caption + 1
End Sub