mükerrer kayıt uyarısını birden fazla denetime dayandırma

Katılım
28 Ekim 2006
Mesajlar
242
Excel Vers. ve Dili
Office 2003 Türkçe
Private Sub adısoyadı_BeforeUpdate(Cancel As Integer)
Dim SID As String
Dim stLinkCriteria As String
SID = Me.[adısoyadı].Value
stLinkCriteria = "[adısoyadı]=" & "'" & SID & "'"
If DCount("[adısoyadı]", "giriş", stLinkCriteria) > 0 Then
'Undo duplicate entry
MsgBox "Girmekte Oldugunuz " _
& SID & " isim Daha Önce İşlenmiş." _
& vbCr & vbCr & "Lütfen Kayıtları Kontrol Ediniz.", vbInformation _
, "Mükerrer Kayıt"

End If
End Sub
peki sevgili kardeşlerim, "bir" denetim üzerinden aynı kaydın olup olmadığını kontrol ediyoruz.adsoyad tek denetimde... muhtemelen aynı isimde başka değerlere sahip kayıt ta vardır.bu şekilde sağlıklı sonuç alınmaz diye düşünüyorum. bu kodları bird en fazla denetime nasıl uyarlayacağız? mesela "ad" "soyad" "adres" ...
 
Katılım
28 Ekim 2006
Mesajlar
242
Excel Vers. ve Dili
Office 2003 Türkçe
ben sordum ama deneme-yanılma ,biraz da mantık yürütme yolu ile yapmaya
çalıştım , evet mükerrer kayıt varsa uyarsın ama tek alana dayalı değil,birden fazla alana dayalı.sevgili hocalarım ben denedim çalıştı bi yanlışım varsa rica ediyorumöö düzeltin;aynı isim ama farklı bir soyad girince uyarı yok,kayıt yapıyor,eğer isim ve soyisim de aynı olursa kaydetniyor ve uyarı veriyor.arkadaşlardan aldığım kodu bu şekilde düzenlemeye çalıştım
Private Sub Komut6_Click()
Dim SID1, SID2 As String
Dim stLinkCriteria1, stLinkCriteria2 As String
Dim rsc As DAO.Recordset

Set rsc = Me.RecordsetClone

SID1 = Me.[adı].Value
SID2 = Me.[soyadı].Value
stLinkCriteria1 = "[adı]=" & "'" & SID1 & "'"
stLinkCriteria2 = "[soyadı]=" & "'" & SID2 & "'"

If DCount("[adı]", "kişiler", stLinkCriteria1) And DCount("[soyadı]", "kişiler", stLinkCriteria2) > 0 Then
'Undo duplicate entry
Me.Undo

MsgBox "Girmeye çalıştığınız " _
& SID & " No'lu ALANADI daha önce girilmiş." _
& vbCr & vbCr & "Lütfen Kayıtlarınızı Kontrol Ediniz.", vbInformation _
, "Tekrarlanan ALANADI Numarası"

rsc.FindFirst stLinkCriteria1
Me.Bookmark = rsc.Bookmark
End If


Set rsc = Nothing

End Sub
 
Üst