operation is not allowed when the object is open....

Question

Meenakshi_2 0 Newbie Poster

5 Years Ago

Option Explicit
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim list As ListItem

Sub Connection()

    cn.Open "provider=microsoft.jet.oledb.4.0;data source=C:\Users\Archana\Documents\login.mdb;"
    rs.CursorLocation = adUseClient
    rs.Open "ARegistration", cn, adOpenKeyset, adLockPessimistic

End Sub

Private Sub cboAid_Click()

    rs.Open "Select * from ARegistration", cn, adOpenDynamic, adLockOptimistic
    rs.MoveFirst
    Do While Not rs.EOF
        If cboAid.Text = rs.Fields(0) Then
            txtAname.Text = rs(1)
            cboState.Text = rs(2)
            cboCity = rs(3)
            txtPincode = rs(4)
            txtAddress = rs(5)
            txtPhoneno = rs(6)
            DTPicker1 = rs(7)
            cboGender = rs(8)
            cboQualification = rs(9)
            Exit Sub
            rs.Close
        End If
        rs.MoveNext
    Loop

End Sub

Private Sub cboState_Click()

    cboCity.Clear
    If cboState.Text = "Tamilnadu" Then
        cboCity.AddItem "Madurai"
        cboCity.AddItem "Trichy"
        cboCity.AddItem "Coimbatore"
        cboCity.AddItem "Chennai"
    ElseIf cboState.Text = "Kerala" Then
        cboCity.AddItem "Thiruvananthapuram"
        cboCity.AddItem "Kollam"
        cboCity.AddItem "Ernakulam"
        cboCity.AddItem "Kochi"
    ElseIf cboState.Text = "Karnataka" Then
        cboCity.AddItem "Bangalore"
        cboCity.AddItem "Mangalore"
        cboCity.AddItem "Chikmagalur"
        cboCity.AddItem "Mysore"
    ElseIf cboState.Text = "Andhra Pradesh" Then
        cboCity.AddItem "Chittoor"
        cboCity.AddItem "Visakapatnam"
        cboCity.AddItem "Vizianagaram"
        cboCity.AddItem "Cuddapah"
    End If

End Sub

Private Sub cmdAdd_Click()

    makeclear
    rs.AddNew

End Sub

Private Sub cmdClear_Click()

    rs.CancelUpdate
    cmdFirst_Click
    DTPicker1.CustomFormat = "dd-MMM-yyyy"

End Sub

Private Sub cmdFirst_Click()

    rs.MoveFirst
    extract

End Sub

Private Sub cmdLast_Click()

    rs.MoveLast
    extract

End Sub

Private Sub cmdNext_Click()

    rs.MoveNext
    If rs.EOF Then rs.MoveLast
    extract

End Sub

Private Sub cmdPrevious_Click()

    rs.MovePrevious
    If rs.BOF Then rs.MoveFirst
    extract

End Sub

Private Sub cmdQuit_Click()

End

End Sub

Private Sub cmdRegister_Click()

    loaddata
    Submit
    rs.Update
    MsgBox "Record Updated Successfully"

End Sub

Private Sub Submit()

    rs(1) = txtAname
    rs(2) = cboState
    rs(3) = cboCity
    rs(4) = txtPincode
    rs(5) = txtAddress
    rs(6) = txtPhoneno
    rs(7) = DTPicker1
    rs(8) = cboGender
    rs(9) = cboQualification

End Sub

Private Sub cmdDelete_Click()

    Dim a As Integer
    If rs.BOF = False And rs.EOF = False Then
        a = MsgBox("Are you Sure?", vbYesNo)
        If a = vbYes Then
            rs.Delete
            MsgBox "Deleted"
            extract
        End If
    Else
        MsgBox "No current Record"
    End If

End Sub

Private Sub extract()

    cboAid = rs(0)
    txtAname = rs(1)
    cboState = rs(2)
    cboCity = rs(3)
    txtPincode = rs(4)
    txtAddress = rs(5)
    txtPhoneno = rs(6)
    DTPicker1 = rs(7)
    cboGender = rs(8)
    cboQualification = rs(9)

End Sub

Private Sub makeclear()

    cboAid = Empty
    txtAname = Empty
    cboState = Empty
    cboCity = Empty
    txtPincode = Empty
    txtAddress = Empty
    txtPhoneno = Empty
    DTPicker1.CustomFormat = ""
    cboGender = Empty
    cboQualification = Empty

End Sub

Private Sub Command1_Click()

    loaddata
    Submit
    rs.Update

End Sub

Private Sub Form_Load()

    Connection

    If rs.RecordCount > 0 Then
        rs.MoveFirst
        While Not rs.EOF
            cboAid.AddItem rs(0)
            rs.MoveNext
        Wend
    End If

    With ListView1.ColumnHeaders
        .Add , , "Aid", Width / 5
        .Add , , "Aname", Width / 5
        .Add , , "State", Width / 5
        .Add , , "City", Width / 5
        .Add , , "Pincode", Width / 5
        .Add , , "Address", Width / 5
        .Add , , "Phno", Width / 5
        .Add , , "dob", Width / 5
        .Add , , "Gender", Width / 5
        .Add , , "Qualification", Width / 5
    End With

    loaddata

    Form3.Caption = ""

    lblAid.Caption = "Agent ID"
    LblAname.Caption = "Agent Name"
    lblState.Caption = "State"
    lblCity.Caption = "City"
    lblPincode.Caption = "Pincode"
    LblAddress.Caption = "Address"
    lblPhoneno.Caption = "Phone no"
    lblDob.Caption = "DOB"
    LblGender.Caption = "Gender"
    LblQualification.Caption = "Qualification"

    txtAname.Text = ""
    txtPincode.Text = ""
    txtAddress.Text = ""
    txtPhoneno.Text = ""

    cmdRegister.Caption = "&Register"
    cmdDelete.Caption = "&Delete"
    cmdAdd.Caption = "&Add"
    cmdFirst.Caption = "&First"
    cmdLast.Caption = "&Last"
    cmdPrevious.Caption = "&Previous"
    cmdNext.Caption = "&Next"
    cmdQuit.Caption = "&Quit"

    DTPicker1.Format = dtpCustom
    DTPicker1.CustomFormat = "dd-MMM-yyyy"

    cboGender.AddItem "male"
    cboGender.AddItem "Female"
    cboGender.AddItem "others"

    cboQualification.AddItem "B.Sc.,(C.S)"
    cboQualification.AddItem "B.Sc.,(IT)"
    cboQualification.AddItem "BCA"

    cboState.AddItem "Tamilnadu"
    cboState.AddItem "Kerala"
    cboState.AddItem "Karnataka"
    cboState.AddItem "Andhra Pradesh"

End Sub

Private Sub txtPhoneno_KeyPress(KeyAscii As Integer)

    If Not IsNumeric(txtPhoneno.Text & Chr(KeyAscii)) And Not KeyAscii = 8 Then KeyAscii = 0
    If KeyAscii >= 43 And KeyAscii <= 46 Then KeyAscii = 0
    If KeyAscii = 13 Then
        If Len(txtPhoneno) >= 10 Then
            DTPicker1.SetFocus
        Else
            MsgBox "invalid", vbCritical, "Please enter valid Phone no"
        End If
    End If

End Sub

Private Sub txtPincode_KeyPress(KeyAscii As Integer)

    If Not IsNumeric(txtPincode.Text & Chr(KeyAscii)) And Not KeyAscii = 8 Then KeyAscii = 0
    If KeyAscii >= 43 And KeyAscii <= 46 Then KeyAscii = 0

End Sub

Sub loaddata()

    ListView1.ListItems.Clear
    ListView1.ListItems.Add
    rs.Open "Select * from Aregistration", cn, adOpenDynamic, adLockOptimistic
    Do Until rs.EOF
        Set list = ListView1.ListItems.Add(, , rs!Aid)
        list.SubItems(1) = rs!Aname
        list.SubItems(2) = rs!State
        list.SubItems(3) = rs!City
        list.SubItems(4) = rs!Pincode
        list.SubItems(5) = rs!Address
        list.SubItems(6) = rs!Phoneno
        list.SubItems(7) = rs!Dob
        list.SubItems(8) = rs!Gender
        list.SubItems(9) = rs!Qualification
        rs.MoveNext
    Loop

    rs.Close

End Sub

*Bold Text Here*

visual-basic

Edited 5 Years Ago by Reverend Jim because: Corrected code formatting

3 Contributors
2 Replies
415 Views
1 Hour Discussion Span
Latest Post 5 Years Ago Latest Post by Reverend Jim

rproffitt 2,662 "Nothing to see here."

5 Years Ago

A few comments. Use the code formatting when posting code. Also, this will add line numbers so you can point out which line.

Reply to this topic

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.

score 1 · Answer 1 · 2019-04-15T06:58:36+00:00

I corrected the code formatting.

Please note that of lines 29 and 30

Exit Sub
rs.Close

there is no way that line 30 will ever get executed so it is possible this is leading to your error by leaving the connection open.

Also, line 141

If rs.BOF = False And rs.EOF = False Then

could be better written as

If Not (rs.BOF Or rs.EOF) Then