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
