Hi all,
I have form to populate list view items which allows the user to view, add, update, and delete model records. But when i start the project, the Run-time error '380': Invalid Property Value comes. i click to debug, it highlighted a line as i have indicated below in the code. Please anyone help me to resolve this problem which I'm struggling with for more than a week.
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()
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
Call ConnectDB
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
With rs
Do While Not .EOF
Set lItem = Me.LVMMaster.ListItems.Add
[B]lItem.SubItems(1) = !model_name[/B] '>>>> this line
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 FunctionAny help greatly appreciated.
shena
