Listview issue

[firoz.raj]

i simple was to add information in a listview using save button.
but when click save it hangs.kindly help me .any help would be
Greately appreciated.
here is the code what i have written.

Private Sub btSave_Click()
        Dim con As New ADODB.Connection
        Dim rs As New ADODB.Recordset
        
'        On Error GoTo ErrHnd
        If (CheckInput) = True Then
        If MsgBox("do you add this record", vbYesNo + vbQuestion, "message") = vbYes Then
           Set con = New ADODB.Connection
           If OpenConnection(con) Then
              MsgBox ("Cannot open Connection")
              End If
        Set rs = New ADODB.Recordset
        rs.Open "Select * from supplierS", con, adOpenDynamic, adLockOptimistic
        rs.AddNew
        rs.Fields("type_id") = Combo1.ItemData(Combo1.ListIndex)
     '  rs.Fields("item_type") = Combo1.Text
'       rs.Fields("sup_id") = Val(Text1.Text)
        rs.Fields("Sup_name") = TxtSupName.Text
        rs.Fields("Contact_person") = TxtCperson.Text
        rs.Fields("contact_no") = TxtContactNo.Text
        rs.Fields("office_address") = TxtOfficeAdd.Text
        rs.Fields("email") = Txtemail.Text
        rs.Fields("website") = TxtWebsite.Text
        rs.Fields("fax_no") = TxtFax.Text
        rs.Update
        rs.Close
        MsgBox ("Data Saved")
        Call frmSupplier.Addtolistview
      End If
      End If
'      Call CloseConnection(con)
      Exit Sub

[vb5prgrmr]

Okay, the part you tried to highlight in red is constantly returning zero and it should be something like...

... = Combo1.ListIndex

That is, if what you need is the index number but if your field is 1 based and not zero based like the combo then you will need to do

... = (Combo1.ListIndex + 1)

However, if you are wanting to retrieve the text listed/selected in the combo box then you need...

... = Combo1.Text

Good Luck

[firoz.raj]

Right know i got error . duplication error.Kindly find the attachment.
also.Kindly let me know some idea.any help would be Greatly
appreciated.

Private Sub btSave_Click()
        Dim con As New ADODB.Connection
        Dim rs As New ADODB.Recordset
        
'        On Error GoTo ErrHnd
        If (CheckInput) = True Then
        If MsgBox("do you add this record", vbYesNo + vbQuestion, "message") = vbYes Then
           Set con = New ADODB.Connection
           If OpenConnection(con) Then
              MsgBox ("Cannot open Connection")
              End If
        Set rs = New ADODB.Recordset
        rs.Open "Select * from supplierS", con, adOpenDynamic, adLockOptimistic
        rs.AddNew
        rs.Fields("type_id") = Combo1.ItemData(Combo1.ListIndex)
     '  rs.Fields("item_type") = Combo1.Text
'       rs.Fields("sup_id") = Val(Text1.Text)
        rs.Fields("Sup_name") = TxtSupName.Text
        rs.Fields("Contact_person") = TxtCperson.Text
        rs.Fields("contact_no") = TxtContactNo.Text
        rs.Fields("office_address") = TxtOfficeAdd.Text
        rs.Fields("email") = Txtemail.Text
        rs.Fields("website") = TxtWebsite.Text
        rs.Fields("fax_no") = TxtFax.Text
        rs.Update
        rs.Close
        MsgBox ("Data Saved")
        Call frmSupplier.Addtolistview
      End If
      End If
'      Call CloseConnection(con)
      Exit Sub
'ErrHnd:
'      Call MsgBox(Err.description, vbOKOnly + vbCritical, "SAVESUPPLIERDATA")
'      Err.Clear
'      On Error GoTo 0
'      Call CloseRecordset(rs)
'      Call CloseConnection(con)
      
        Me.Refresh
'        Call Addtolistview
        Combo1.Text = ""
        TxtSupName.Text = ""
        TxtCperson.Text = ""
        TxtContactNo.Text = ""
        TxtOfficeAdd.Text = ""
        Txtemail.Text = ""
        TxtFax.Text = ""
        TxtWebsite.Text = ""
         con.BeginTrans
'       SQL = "INSERT INTO Supplier(item_type,Supplier_id,Supplier_name,Contact_person,Contact_no,Office_address,emails,website,Fax_no) values('" & Combo1.Text & "','" & Text1.Text & "','" & Text2.Text & " ','" & Text4.Text & "','" & Text3.Text & "','" & Text5.Text & "','" & Text6.Text & "','" & Text7.Text & "','" & Text8.Text & "')"
'       con.Execute (SQL)
'       con.CommitTrans
        End Sub
Private Sub FillSupplierTypes()
'  dim rs as Adodb.Recordset,dim con as
End Sub


Private Sub Form_Load()
Combo1.AddItem "Engineering Service"
Combo1.AddItem "Maintenance Suppliers"
End Sub

Private Function CheckInput() As Boolean
If Combo1.Text = "Combo1" Then
   MsgBox "There value needed for Type", vbInformation, Me.Name
   TxtSupName.SetFocus
   Exit Function
End If
If TxtSupName.Text = "" Then
   MsgBox "SUPPLIER NO CANNOT BE BLANK", vbInformation, Me.Name
   TxtCperson.SetFocus
   Exit Function
End If
If TxtCperson.Text = "" Then
   MsgBox "SUPPLIER NAME CANNOT BE BLANK", vbInformation, Me.Name
   TxtContactNo.SetFocus
   Exit Function
   End If
If TxtContactNo.Text = "" Then
   MsgBox "CONTACT PERSON CANNOT BE BLANK", vbInformation, Me.Name
   TxtOfficeAdd.SetFocus
   Exit Function
End If
If TxtOfficeAdd.Text = "" Then
   MsgBox "CONTACT NOS CANNOT BE BLANK", vbInformation, Me.Name
   Txtemail.SetFocus
   Exit Function
 End If
   If Txtemail.Text = "" Then
    MsgBox "Office Address cannot be blank"
    TxtWebsite.SetFocus
    Exit Function
    End If
 If Txtemail.Text = "" Then
    MsgBox "Emails Cannot be blank"
    TxtWebsite.SetFocus
    Exit Function
 End If
 
 If TxtWebsite.Text = "" Then
    MsgBox "Website Cannot be blank"
    TxtWebsite.SetFocus
    Exit Function
  End If
  CheckInput = True
  End Function

[vb5prgrmr]

Okay, what that error is telling you is that you have a unique field ID or otherwise and you are trying to add a duplicate entry. So the question arises. Are you trying to add a duplicate entry or update an ID field? Perhaps a look at your table structure might help because if you have a field that is supposed to be a foreign key but you have it constricted with a unique constraint then that may be your problem.

Good Luck