Quantcast
Channel: VBForums - Visual Basic 6 and Earlier
Viewing all articles
Browse latest Browse all 21271

how to update without a duplicate name

$
0
0
hey

im trying to update a customer but when i try to change something in his details i get
name already exists in the database.
i did this only when i add a new cust.
cant figure out how to fix it.
if i add a new cust then it will recognize if i put the same name in the db but if i update i want it to alow me to change his phone number
or street address without telling me name already in the base.
this is my code:
Code:

Private Sub BttnSave_Click()

If Txt(0).Text = "" Then
MsgBox "name missing"
Txt(0).SetFocus
Exit Sub
End If

If Txt(1).Text = "" Then
MsgBox "phone missing"
Txt(1).SetFocus
Exit Sub
End If

If Txt(2).Text = "" Then
MsgBox "cell missing"
Txt(2).SetFocus
Exit Sub
End If

If Txt(3).Text = "" Then
MsgBox "company missing"
Txt(3).SetFocus
Exit Sub
End If

If Txt(4).Text = "" Then
MsgBox "branch missing"
Txt(4).SetFocus
Exit Sub
End If

If Txt(5).Text = "" Then
MsgBox "fax missing"
Txt(5).SetFocus
Exit Sub
End If

If Txt(6).Text = "" Then
MsgBox "phone office missing"
Txt(6).SetFocus
Exit Sub
End If

  If NewRec Then
        If Not FrmCusts.LsVw.FindItem(Txt(0).Text) Is Nothing Then
            MsgBox "This student already exits!", vbExclamation, "SAVE"
            Txt(0).SetFocus
            Exit Sub
        End if
        Dim NewID As Long
        NewID = NextID("SupID", "Suppliers")
        Dim strSQL As String
strSQL = "INSERT INTO Suppliers "
strSQL = strSQL & "(SupID, SupName, SupPhone, SupCell, SupCompany, SupBranch, SupFax, SupPhoneOffice, SupCredit, SupDiscount, SupRemarks)"
strSQL = strSQL & "VALUES("
strSQL = strSQL & NewID & ","
strSQL = strSQL & "'" & RplS(Txt(0).Text) & "',"
strSQL = strSQL & "'" & RplS(Txt(1).Text) & "',"
strSQL = strSQL & "'" & RplS(Txt(2).Text) & "',"
strSQL = strSQL & "'" & RplS(Txt(3).Text) & "',"
strSQL = strSQL & "'" & RplS(Txt(4).Text) & "',"
strSQL = strSQL & "'" & RplS(Txt(5).Text) & "',"
strSQL = strSQL & "'" & RplS(Txt(6).Text) & "',"
strSQL = strSQL & "'" & RplS(Txt(7).Text) & "',"
strSQL = strSQL & "'" & RplS(Txt(8).Text) & "',"
strSQL = strSQL & "'" & RplS(Txt(9).Text) & "'"
strSQL = strSQL & ")"
CN.Execute strSQL

        Set Itm = FrmSuppliers.LsVw.ListItems.Add(, , Txt(0).Text, , "sup")
        Itm.Tag = NewID
        Itm.SubItems(1) = Replace$(Txt(1).Text, ",", ".")
        Itm.SubItems(2) = Replace$(Txt(2).Text, ",", ".")
        Itm.SubItems(3) = Replace$(Txt(3).Text, ",", ".")
        Itm.SubItems(4) = Replace$(Txt(4).Text, ",", ".")
        Itm.SubItems(5) = Replace$(Txt(5).Text, ",", ".")
        Itm.SubItems(6) = Replace$(Txt(6).Text, ",", ".")
        Itm.SubItems(7) = Replace$(Txt(7).Text, ",", ".")
        Itm.SubItems(8) = Replace$(Txt(8).Text, ",", ".")
        Itm.SubItems(9) = Replace$(Txt(9).Text, ",", ".")
 
        If ChkRepeat.Value Then
            Txt(0).Text = ""
            Txt(1).Text = ""
            Txt(2).Text = ""
            Txt(3).Text = ""
            Txt(4).Text = ""
            Txt(5).Text = ""
            Txt(6).Text = ""
            Txt(7).Text = ""
            Txt(8).Text = ""
            Txt(9).Text = ""
            ChkRepeat.Value = 0
         
            Exit Sub
        End If
    Else
        With FrmCusts.LsVw.SelectedItem
            If Not FrmCusts.LsVw.FindItem(Txt(0).Text) Is Nothing And LCase$(Txt(0).Text) <> LCase$(.Text) Then
                MsgBox "This Supllier already exits!", vbExclamation, "UPDATE"
                Txt(0).SetFocus
                Exit Sub
            End If
        strSQL = "UPDATE Suppliers SET "   
strSQL = strSQL & "SupName = '" & RplS(Txt(0).Text) & "',"
strSQL = strSQL & "SupPhone = '" & RplS(Txt(1).Text) & "',"
strSQL = strSQL & "SupCell = '" & RplS(Txt(2).Text) & "',"
strSQL = strSQL & "SupCompany = '" & RplS(Txt(3).Text) & "',"
strSQL = strSQL & "SupBranch = '" & RplS(Txt(4).Text) & "',"
strSQL = strSQL & "SupFax = '" & RplS(Txt(5).Text) & "',"
strSQL = strSQL & "SupPhoneOffice = '" & RplS(Txt(6).Text) & "',"
strSQL = strSQL & "SupCredit = '" & RplS(Txt(7).Text) & "',"
strSQL = strSQL & "SupDiscount = '" & RplS(Txt(8).Text) & "',"
strSQL = strSQL & "SupRemarks = '" & RplS(Txt(9).Text) & "'"
strSQL = strSQL & " WHERE SupID = " & .Tag
CN.Execute strSQL
         
            Txt(0).Text = .Text
            Txt(1).Text = .SubItems(1)
            Txt(2).Text = .SubItems(2)
            Txt(3).Text = .SubItems(3)
            Txt(4).Text = .SubItems(4)
            Txt(5).Text = .SubItems(5)
            Txt(6).Text = .SubItems(6)
            Txt(7).Text = .SubItems(7)
            Txt(8).Text = .SubItems(8)
            Txt(9).Text = .SubItems(9)
        End With
    End If
    Unload Me
Call FrmSuppliers.Loadentries
End Sub

tnx for the help

Viewing all articles
Browse latest Browse all 21271

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>