Sayın hocalarım webden veri alırken eğer o kayıt var ise o kaydı güncellesin, eğer kayıt yok ise kayıt eklesin istiyorum yardımlarınız bekliyorum.

Bahsettiğiniz işlem, "aliste1" isimli form için yapılmıştır.

Butonun tıklandığında olayındaki kodu aşağıdaki ile değiştiriniz.

 Dim IE As Object

Dim HTML_Body As Object, HTML_Tables As Object, MyTable As Object

Dim HTML_TableRows As Object

Dim X, Y, Z, Guncel, Yeni As Integer

      

Set IE = Me.WebBrowser1

Set HTML_Body = IE.Document.All

Set HTML_Tables = HTML_Body.tags("Table")

Set MyTable = HTML_Tables(41)

Set HTML_TableRows = MyTable.GetElementsByTagName("td")



For Each MyRow In HTML_TableRows

X = X + 1

Next



Z = (X - 8) / 8



ReDim sorgu(5, Z - 1)  

  

X = 0

Guncel = 0

Yeni = 0



For X = 0 To Z - 1

Y = 1 + (1 * X)

sorgu(0, X) = MyTable.Rows(Y).Cells(1).innerText

sorgu(1, X) = MyTable.Rows(Y).Cells(2).innerText

sorgu(2, X) = MyTable.Rows(Y).Cells(3).innerText

sorgu(3, X) = MyTable.Rows(Y).Cells(4).innerText

sorgu(4, X) = MyTable.Rows(Y).Cells(5).innerText

Next X

       

 '  Me.tumalani = Y + X - 3



Dim rc As DAO.Recordset

Set rc = CurrentDb.OpenRecordset("tliste1")

  

X = 0

  

For X = 0 To Z - 1



strSQl = "SELECT * FROM tliste1 "

Set rstkayit = New ADODB.Recordset

rstkayit.Open strSQl, CurrentProject.Connection, adOpenKeyset, adLockOptimistic



With rstkayit

.Find "[tcno]=" & "'" & sorgu(0, X) & "'"



If Not rstkayit.EOF Then

.Fields("adi") = sorgu(1, X)

.Fields("asyd") = sorgu(2, X)

.Fields("okulno") = sorgu(3, X)

.Fields("sinif") = Left(sorgu(4, X), InStr(1, sorgu(4, X), ".") - 1)

.Fields("sube") = Left(Trim(Mid(sorgu(4, X), InStr(1, sorgu(4, X), "/") + 1)), 1)

.Fields("alani") = Left(Trim(Mid(sorgu(4, X), InStr(1, sorgu(4, X), "(") + 1)), InStr(1, Trim(Mid(sorgu(4, X), InStr(1, sorgu(4, X), "(") + 1)), ")") - 1)

Guncel = Guncel + 1

.Update

Else

.AddNew

.Fields("tcno") = sorgu(0, X)

.Fields("adi") = sorgu(1, X)

.Fields("asyd") = sorgu(2, X)

.Fields("okulno") = sorgu(3, X)

.Fields("sinif") = Left(sorgu(4, X), InStr(1, sorgu(4, X), ".") - 1)

.Fields("sube") = Left(Trim(Mid(sorgu(4, X), InStr(1, sorgu(4, X), "/") + 1)), 1)

.Fields("alani") = Left(Trim(Mid(sorgu(4, X), InStr(1, sorgu(4, X), "(") + 1)), InStr(1, Trim(Mid(sorgu(4, X), InStr(1, sorgu(4, X), "(") + 1)), ")") - 1)

Yeni = Yeni + 1

.Update

End If

End With

Next X

  

MsgBox ("aktarım tamamlanmıştır," & Chr(13) & Chr(10) & "Yeni Eklenen Kayıt: " & Yeni & " Adet," & Chr(13) & Chr(10) & "Güncellenen Kayıt: " & Guncel & " Adet."), vbInformation, "AKTARIM MESAJI"

  

Set rc = Nothing

Set HTML_Body = Nothing

Set HTML_Tables = Nothing

Set MyTable = Nothing

Set HTML_TableRows = Nothing

Set HTML_TableDivisions = Nothing

Set IE = Nothing

Sayın ozanakkaya hocam; ellerinize sağlık, sorunum çözüldü. Yardımlarınız için çok teşekkür ederim. Daha öğreneceğim çok şey var galiba.