AccessTr.neT

Tam Versiyon: webden bilgi alma
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2 3 4 5 6 7 8 9 10 11
mükerrer olanları almasın kısmını yapamadım. mükererr kayıt uyarısı verdiği halde tekrar kayıt yapıyor.
kod aşağıda nerde yanlış yaptım acaba?

Kod:
Private Sub Etiket79_Click()

On Error Resume Next
Dim IE As Object
Set IE = Me.WebBrowser1


Dim k As Integer


For k = 1 To 100

DoCmd.GoToRecord , T_VERITABLOSU, acGoTo, last

Me.Metin1 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(0).innerText
Me.Metin2 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(1).innerText
Me.Metin3 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(2).innerText
Me.Metin4 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(3).innerText
Me.Metin5 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(4).innerText
Me.Metin6 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(5).innerText
Me.Metin7 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(6).innerText
Me.Metin8 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(7).innerText
Me.Metin9 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(8).innerText
Me.Metin10 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(9).innerText
Me.Metin11 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(10).innerText
Me.Metin12 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(11).innerText


Dim strSQL As String
strSQL = "SELECT * T_VERITABLOSU"
Set rstkayit = New ADODB.Recordset
rstkayit.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

With rstkayit
.Find "[ISEMRINO]='" & Me.Metin1 & "'"
If Not rstkayit.EOF Then
If MsgBox("" & Metin1 & " nolu işemri  daha önceden kaydedilmiş, Veri Güncellensin mi?", vbYesNo, "Kaydediliyor...") = vbYes Then
.Fields("ISEMRINO") = Me.Metin1
.Fields("ILCE") = Me.Metin2
.Fields("MAHALLE") = Me.Metin3
.Fields("SOKAK") = Me.Metin4
.Fields("BINANO") = Me.Metin5
.Fields("ACIKLAMA") = Me.Metin6
.Fields("CAGRITURU") = Me.Metin7
.Fields("CEVAP") = Me.Metin8
.Fields("KAYITTARIHI") = Me.Metin9
.Fields("FAALIYETTARIHI") = Me.Metin10
.Fields("FAALIYETKODU") = Me.Metin11
.Fields("FAALIYETACIKLAMASI") = Me.Metin12
.Update
Else

End If
Else
.AddNew
.Fields("ISEMRINO") = Me.Metin1
.Fields("ILCE") = Me.Metin2
.Fields("MAHALLE") = Me.Metin3
.Fields("SOKAK") = Me.Metin4
.Fields("BINANO") = Me.Metin5
.Fields("ACIKLAMA") = Me.Metin6
.Fields("CAGRITURU") = Me.Metin7
.Fields("CEVAP") = Me.Metin8
.Fields("KAYITTARIHI") = Me.Metin9
.Fields("FAALIYETTARIHI") = Me.Metin10
.Fields("FAALIYETKODU") = Me.Metin11
.Fields("FAALIYETACIKLAMASI") = Me.Metin12
.Update
End If
End With


DoCmd.GoToRecord , , acNext                  'Bir sonraki kayıda git

k = k + 1

Next

End Sub
henüz hatamı bulamadım.
Programınızın nasıl çalıştığını adım adım takip edip; hatanızın nerede olduğunu, hangi kontrolde problem olduğunu kendinizde görebilirsiniz.

Bunun için aşağıdaki konudaki 6 nolu mesajımdaki açıklamaları okuyun.
SQL dizesi hata veriyor

Kodu aşağıdaki şekilde değiştirip çalıştırmayı dener misiniz?

Kod:
Private Sub Etiket79_Click()

On Error Resume Next
Dim IE As Object
Set IE = Me.WebBrowser1
Dim k As Integer
Dim Deger1, Deger2, Deger3, Deger4, Deger5, Deger6, Deger7, Deger8, Deger9, Deger10, Deger11, Deger12

Dim strSQL As String
    strSQL = "SELECT * T_VERITABLOSU"
    Set rstkayit = New ADODB.Recordset
    rstkayit.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    
    For k = 1 To 100
    
        Deger1 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(0).innerText
        Deger2 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(1).innerText
        Deger3 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(2).innerText
        Deger4 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(3).innerText
        Deger5 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(4).innerText
        Deger6 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(5).innerText
        Deger7 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(6).innerText
        Deger8 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(7).innerText
        Deger9 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(8).innerText
        Deger10 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(9).innerText
        Deger11 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(10).innerText
        Deger12 = IE.Document.All.tags("table").Item(13).Rows(k).Cells(11).innerText
        
        With rstkayit
            .Find "[ISEMRINO]='" & Deger1 & "'"
            If rstkayit.EOF Then
                .AddNew
                .Fields("ISEMRINO") = Deger1
                .Fields("ILCE") = Deger2
                .Fields("MAHALLE") = Deger3
                .Fields("SOKAK") = Deger4
                .Fields("BINANO") = Deger5
                .Fields("ACIKLAMA") = Deger6
                .Fields("CAGRITURU") = Deger7
                .Fields("CEVAP") = Deger8
                .Fields("KAYITTARIHI") = Deger9
                .Fields("FAALIYETTARIHI") = Deger10
                .Fields("FAALIYETKODU") = Deger11
                .Fields("FAALIYETACIKLAMASI") = Deger12
                .Update
            Else
                If MsgBox("" & Deger1 & " nolu işemri daha önceden kaydedilmiş, Veri Güncellensin mi?", vbYesNo, "Kaydediliyor...") = vbYes Then
                    .Fields("ISEMRINO") = Deger1
                    .Fields("ILCE") = Deger2
                    .Fields("MAHALLE") = Deger3
                    .Fields("SOKAK") = Deger4
                    .Fields("BINANO") = Deger5
                    .Fields("ACIKLAMA") = Deger6
                    .Fields("CAGRITURU") = Deger7
                    .Fields("CEVAP") = Deger8
                    .Fields("KAYITTARIHI") = Deger9
                    .Fields("FAALIYETTARIHI") = Deger10
                    .Fields("FAALIYETKODU") = Deger11
                    .Fields("FAALIYETACIKLAMASI") = Deger12
                    .Update
                End If
            End If
        End With
    
    Next
    
    rstkayit.Close

End Sub

Öncelikle k değerini 1'den 100'e kadar döngüye sokmuşsun ama döngü içerisinde k'yı tekrar 1 artırmışsın.
For fonksiyonu zaten otomatik olarak k'nın değerini her seferinde 1 artıracaktır.
Kod:
For k = 1 To 100
...
    k = k + 1
Next
Bu şekilde k degeri 1,3,5...99 olarak gider.
Sen zaten böyle gitmesini istiyorsan step parametresini kullan.

Kod:
For k = 1 To 100 step 2
...
Next
Ado recordset tanımlama ve açma işini döngü içine koymuşsun,
bu nedenle 100 sefer ado recordset tanımlıyor ve açıyorsun ama bu arada da hiç kapatmıyorsun.
Kod:
For k = 1 To 100
    strSQL = "SELECT * T_VERITABLOSU"
    Set rstkayit = New ADODB.Recordset
    rstkayit.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
...
Next
Ado recordset tanımlama ve açma işini döngü dışına al ve en sonda close ile kapat.
Fazladan kayıt işlemine gelince;
Son örnek dosyanı göremedim ve dolayısıyla kullandığın formun özelliklerini inceleyemedim.
Ama tahmin ettiğim şey şu:Büyük ihtimalle formu tabloya bağlamış ve me.metinx şeklinde metin kutularını tablo alanlarına bağlamışsın.
Bu durumda Kaydetme işleminde tabloya hem ADO ile kayıt yapıyorsun,
hemde kullandığın
Kod:
DoCmd.GoToRecord , , acNext 'Bir sonraki kayıda git
komutu ile direkt formdan kayıt yapıyorsun.
Yani tahminen sen zaten her aldığın yeni bir değeri 2 sefer kayıt ettiriyorsun.
Mükerrer sorup hayır dediğinde 1 kez kaydediyorsun.


Eğer yine de problemini çözemezsen kullandığın dosyanın son halini ekle.
Tekrar inceleyelim.
Sayfalar: 1 2 3 4 5 6 7 8 9 10 11