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 SubPlease anyone help on this problem. Any help greatly appreciated. Thank you in advance for your help.
