VB6 run time error 3709

[shena]

Respedted Seniors,

I have a form to input a product model detail. When i run the project and choose to click the menu 'Model Master', an error as below occurred.

Run-time error '3709':
The connection cannot be used to perform this operation. it is either closed or invalid in this context.

When i click debug, it highlighted the line as i have indicated below in the code:

------------------
frmMdelMaster.frm
------------------

Public search As Boolean
Private Sub cmdMMDelete_Click()
Dim bDMMaster As Boolean
bDMMaster = False
For i = 1 To Me.LVMMaster.ListItems.Count
 If Me.LVMMaster.ListItems(i).Checked = True Then
    Me.DELETE_MODEL_MASTER (Me.LVMMaster.ListItems(i).ListSubItems(1))
    bDMMaster = True
  End If
Next
If bDMMaster = True Then
MsgBox "Record Deleted", vbInformation
Else
MsgBox "No Record Deleted, To delete Check the boxes", vbCritical
End If
Call GET_LV_MODEL_MASTER
End Sub

Private Sub cmdSave_Click()
'Call ConnectDB

If Len(Me.txtModel.Text) = 0 Then
    MsgBox "Empty Model", vbCritical
    Exit Sub
End If

If RECORD_EXIST(Me.txtModel.Text) = True Then
DB.Execute "update MODEL_MASTER set BOXID='" & Me.txtBoxID.Text & "'," & _
"MODEL_DESCRIPTION='" & Me.txtDescription.Text & "' where MODEL_NAME='" & Me.txtModel.Text & "'"
Else
DB.Execute "insert into MODEL_MASTER(MODEL_NAME,BOXID,MODEL_DESCRIPTION) VALUES('" & Me.txtModel.Text & _
"','" & Me.txtBoxID.Text & "','" & Me.txtDescription.Text & "')"
MsgBox "Record Saved!", vbInformation
End If
Call GET_LV_MODEL_MASTER
End Sub

Private Sub cmdSearch_Click()
search = True
Me.GET_LV_MODEL_MASTER

End Sub

Private Sub Form_Load()
 'bModelMaster = False
Call GET_LV_MODEL_MASTER


End Sub

Private Sub LVMMaster_Click()
On Error Resume Next
Dim rs As New ADODB.Recordset
Dim sql As String
sql = "SELECT * FROM MODEL_MASTER where MODEL_NAME ='" & Me.LVMMaster.SelectedItem.ListSubItems(1).Text & "'"
rs.Open sql, DB, adOpenStatic, adLockReadOnly
With rs
    Do While Not .EOF
        Me.txtBoxID.Text = Me.LVMMaster.SelectedItem.ListSubItems(2).Text
        Me.txtModel.Text = Me.LVMMaster.SelectedItem.ListSubItems(1).Text
        Me.txtDescription.Text = Me.LVMMaster.SelectedItem.ListSubItems(3).Text
    .MoveNext
    Loop
End With
End Sub

Private Sub txtModel_LostFocus()
 Dim strExtract As String
 txtModel.Text = UCase(txtModel.Text)
 
 For i = 1 To Len(txtModel.Text)
 If Mid(txtModel.Text, i, 1) = "-" Then
 Else
 strExtract = strExtract & Mid(txtModel.Text, i, 1)
 End If
 Next
 Me.txtBoxID.Text = strExtract
End Sub


Function GET_LV_MODEL_MASTER()
Me.LVMMaster.ListItems.Clear
Dim rs As New ADODB.Recordset
Dim sql As String
Dim lItem As ListItem
sql = "Select * from MODEL_MASTER"
If search = True Then
sql = sql & " where MODEL_NAME like '%" & Me.txtModel.Text & "%'"
End If
rs.Open sql, DB, adOpenStatic, adLockReadOnly  'this line highlighted -  when cursor 
                                               ' point at DB, it shows (DB=nothing)

With rs
Do While Not .EOF
Set lItem = Me.LVMMaster.ListItems.Add
lItem.SubItems(1) = !model_name
lItem.SubItems(2) = !BOXID
If IsNull(!MODEL_DESCRIPTION) = True Then
Else
lItem.SubItems(3) = !MODEL_DESCRIPTION
End If


.MoveNext
Loop
End With
search = False

End Function

Function DELETE_MODEL_MASTER(ByVal model_name As String)
DB.Execute "delete from MODEL_MASTER where model_name='" & model_name & "'"

End Function

Function RECORD_EXIST(ByVal model_name As String) As Boolean
Dim rs As New ADODB.Recordset
Dim sql As String
Dim lItem As ListItem
sql = "Select * From MODEL_MASTER where MODEL_NAME='" & model_name & "'"
rs.Open sql, DB, adOpenStatic, adLockReadOnly

With rs
Do While Not .EOF
    RECORD_EXIST = True
.MoveNext
Loop
End With
End Function

----------
Module1
----------

Option Explicit
Public DB As ADODB.Connection
Public rs As ADODB.Recordset
Public strSql As String

Sub ConnectDB()
    Dim strDB As String
    Dim varYN As Variant
    varYN = MsgBox("Use Test Environment", vbYesNo)
    If varYN = vbNo Then
    strDB = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.path & "\mydb.mdb;Persist Security Info=False"
    Else
    strDB = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.path & "\TEST_mydb.mdb;Persist Security Info=False"
    End If
    
    Set DB = New ADODB.Connection
    DB.CursorLocation = adUseClient
    DB.Open strDB
End Sub

Please anyone help on this problem. Any help greatly appreciated. Thank you in advance for your help.

[kinwang2009]

Haven't gone through your code but which line gets highlighted when you click debug?

[shena]

Hi,

As i shown in the code tag.

Function GET_LV_MODEL_MASTER()
Me.LVMMaster.ListItems.Clear
Dim rs As New ADODB.Recordset
Dim sql As String
Dim lItem As ListItem
sql = "Select * from LSICBL_MODEL_MASTER"
If search = True Then
sql = sql & " where MODEL_NAME like '%" & Me.txtModel.Text & "%'"
End If
rs.Open sql, DB, adOpenStatic, adLockReadOnly 'this line

With rs
Do While Not .EOF
Set lItem = Me.LVMMaster.ListItems.Add
lItem.SubItems(1) = !model_name
lItem.SubItems(2) = !BOXID
If IsNull(!MODEL_DESCRIPTION) = True Then
Else
lItem.SubItems(3) = !MODEL_DESCRIPTION
End If

.MoveNext
Loop
End With
search = False

End Function

[vb5prgrmr]

Well, what the error is telling you is that the connection object (DB) is not connected to the database, which could mean that the sub connectDB has not been called, and I can see where you have commented it out...

Step through your code to make sure you have opened it, and have not accidently close it...

Good Luck

[shena]

Hi,
Somehow, i missed calling ConnectDB in the program. I then called it within a function and it did work.
Thanks a lot for the advice.
How do i close the connection as my ConnectDB function doesn't include that? How to know where you need to close the connection?

Thanks/shena

[vb5prgrmr]

Connections are expensive, meaning in time and resources. Depending upon the system you are creating and the database you are using you may want to open the connection when the program starts and close the connection when the program ends, which is the easiest way in which to do things. Then when it comes to recordsets, you only keep them open for as long as you need them as they are expensive in their own right and can be even more expensive than a connection object...

Also, you use the pretty much the same syntax in closing a connection as you do with a recordset...

adoRs00.Close
Set adoRs00 = Nothing
adoCn00.Close
Set adoCn00 = Nothing

Good Luck

[shena]

Hi vb5prgrmr,

Thank you for your advice. I managed to do it.