GeordieJon
April 13th, 2007, 09:03 PM
Hi currently doing an application for college. Its a program for a solicitor company. Its written in VB6 and connects to Access 2003 via ADO.
I am currently having problems with adding a new record and deleting a record.
the records load up when the program starts, and i can filter through the records, movenext,previous,first,last ect.
but when i type the new data into the text boxes, it does not add the data to the database, just clears the data and moves to the previous record in the recordset.
and for the delete button, it just comes up with an error.
Run-time error '3251':
Current Recordset does not support updating. This may be a limitation of the provider, or of the selected locktype.
could somebody please help me with these problems please.
'Declare required variables
Dim cn1 As ADODB.Connection
Dim rs1 As ADODB.Recordset
Dim sqlString As String
Private Sub Form_Load()
On Error GoTo ErrorHandler
'Connect to your solicitor database using Microsoft ADO
Set cn1 = New ADODB.Connection
cn1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=" & App.Path & "\solicitor.mdb"
cn1.CursorLocation = adUseClient
'Open the Connection
cn1.Open
'Define an SQL statement (asking for all columns of the Solicitor table)
sqlString = " SELECT * FROM Solicitor"
'execute the SQL statement and put the resulting set of record in recordset variable
Set rs1 = cn1.Execute(sqlString)
If cn1.State = 1 Then
' If database is connected, fill in the fields -
GetFields
End If
Exit Sub
' Error message -
ErrorHandler:
MsgBox Err.Number & vbCrLf & vbCrLf & Err.Description & vbCrLf & vbCrLf & "The program will now close.", vbOKOnly, "Error!"
End
End Sub
Private Sub cmdAdd_Click()
On Error Resume Next
' Check that all fields are filled out -
If txtTitle1.Text = "" Then
MsgBox "Please enter Title.", vbOKOnly, "Data Required"
Exit Sub
Else:
If txtSurname1.Text = "" Then
MsgBox "Please enter a Surname.", vbOKOnly, "Data Required"
Exit Sub
Else:
If txtInitials1.Text = "" Then
MsgBox "Please enter Initials.", vbOKOnly, "Data Required"
Exit Sub
Else:
If txtGrade1.Text = "" Then
MsgBox "Please enter a Grade.", vbOKOnly, "Data Required"
Exit Sub
Else:
If txtPartner1.Text = "" Then
MsgBox "Please enter Partner - Yes or No.", vbOKOnly, "Data Required"
Exit Sub
End If
End If
End If
End If
End If
' Add new record -
sqlString = "Insert INTO Solicitor Title,Surname,Initials,Grade,Partner)" _
& " VALUES (" & txtTitle1.Text & "," & txtSurname1.Text & "," & txtInitials1.Text & _
"," & txtGrade1.Text & "," & txtPartner1.Text & ")"
Set rs1 = cn1.Execute(sqlString)
' Clear the fields -
txtTitle1.Text = ""
txtSurname1.Text = ""
txtInitials1.Text = ""
txtGrade1.Text = ""
txtPartner1.Text = ""
' Go to the new record -
rs1.MoveLast
GetFields
End Sub
Private Sub cmdDelete_Click()
If MsgBox("Are you sure you want to delete this record?", _
vbQuestion + vbYesNo + vbDefaultButton2, _
"Delete Record") _
<> vbYes Then
Exit Sub
End If
With rs1
.Delete
.MoveNext
If .EOF Then .MoveLast
End With
End Sub
Private Sub cmdFirst_Click()
On Error Resume Next
' Go to first record -
rs1.MoveFirst
GetFields
End Sub
Private Sub cmdLast_Click()
On Error Resume Next
' Go to last record -
rs1.MoveLast
GetFields
End Sub
Private Sub cmdNext_Click()
On Error Resume Next
' Go to next record -
rs1.MoveNext
GetFields
End Sub
Private Sub cmdPrevious_Click()
On Error Resume Next
' Go to next record -
rs1.MovePrevious
GetFields
End Sub
Private Sub GetFields()
' Places field data into the text boxes -
txtSolicitor_ID.Text = rs1(0)
txtTitle.Text = rs1(1)
txtSurname.Text = rs1(2)
txtInitials.Text = rs1(3)
txtGrade.Text = rs1(4)
txtPartner.Text = rs1(5)
End Sub
I am currently having problems with adding a new record and deleting a record.
the records load up when the program starts, and i can filter through the records, movenext,previous,first,last ect.
but when i type the new data into the text boxes, it does not add the data to the database, just clears the data and moves to the previous record in the recordset.
and for the delete button, it just comes up with an error.
Run-time error '3251':
Current Recordset does not support updating. This may be a limitation of the provider, or of the selected locktype.
could somebody please help me with these problems please.
'Declare required variables
Dim cn1 As ADODB.Connection
Dim rs1 As ADODB.Recordset
Dim sqlString As String
Private Sub Form_Load()
On Error GoTo ErrorHandler
'Connect to your solicitor database using Microsoft ADO
Set cn1 = New ADODB.Connection
cn1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=" & App.Path & "\solicitor.mdb"
cn1.CursorLocation = adUseClient
'Open the Connection
cn1.Open
'Define an SQL statement (asking for all columns of the Solicitor table)
sqlString = " SELECT * FROM Solicitor"
'execute the SQL statement and put the resulting set of record in recordset variable
Set rs1 = cn1.Execute(sqlString)
If cn1.State = 1 Then
' If database is connected, fill in the fields -
GetFields
End If
Exit Sub
' Error message -
ErrorHandler:
MsgBox Err.Number & vbCrLf & vbCrLf & Err.Description & vbCrLf & vbCrLf & "The program will now close.", vbOKOnly, "Error!"
End
End Sub
Private Sub cmdAdd_Click()
On Error Resume Next
' Check that all fields are filled out -
If txtTitle1.Text = "" Then
MsgBox "Please enter Title.", vbOKOnly, "Data Required"
Exit Sub
Else:
If txtSurname1.Text = "" Then
MsgBox "Please enter a Surname.", vbOKOnly, "Data Required"
Exit Sub
Else:
If txtInitials1.Text = "" Then
MsgBox "Please enter Initials.", vbOKOnly, "Data Required"
Exit Sub
Else:
If txtGrade1.Text = "" Then
MsgBox "Please enter a Grade.", vbOKOnly, "Data Required"
Exit Sub
Else:
If txtPartner1.Text = "" Then
MsgBox "Please enter Partner - Yes or No.", vbOKOnly, "Data Required"
Exit Sub
End If
End If
End If
End If
End If
' Add new record -
sqlString = "Insert INTO Solicitor Title,Surname,Initials,Grade,Partner)" _
& " VALUES (" & txtTitle1.Text & "," & txtSurname1.Text & "," & txtInitials1.Text & _
"," & txtGrade1.Text & "," & txtPartner1.Text & ")"
Set rs1 = cn1.Execute(sqlString)
' Clear the fields -
txtTitle1.Text = ""
txtSurname1.Text = ""
txtInitials1.Text = ""
txtGrade1.Text = ""
txtPartner1.Text = ""
' Go to the new record -
rs1.MoveLast
GetFields
End Sub
Private Sub cmdDelete_Click()
If MsgBox("Are you sure you want to delete this record?", _
vbQuestion + vbYesNo + vbDefaultButton2, _
"Delete Record") _
<> vbYes Then
Exit Sub
End If
With rs1
.Delete
.MoveNext
If .EOF Then .MoveLast
End With
End Sub
Private Sub cmdFirst_Click()
On Error Resume Next
' Go to first record -
rs1.MoveFirst
GetFields
End Sub
Private Sub cmdLast_Click()
On Error Resume Next
' Go to last record -
rs1.MoveLast
GetFields
End Sub
Private Sub cmdNext_Click()
On Error Resume Next
' Go to next record -
rs1.MoveNext
GetFields
End Sub
Private Sub cmdPrevious_Click()
On Error Resume Next
' Go to next record -
rs1.MovePrevious
GetFields
End Sub
Private Sub GetFields()
' Places field data into the text boxes -
txtSolicitor_ID.Text = rs1(0)
txtTitle.Text = rs1(1)
txtSurname.Text = rs1(2)
txtInitials.Text = rs1(3)
txtGrade.Text = rs1(4)
txtPartner.Text = rs1(5)
End Sub