Dim RetVal As Variant, X, a, Y As Integer, SATIRSAYISI As Integer
13 satırına da
For Y = 22 To 60 Step 2
kodunu ekledim ve
21 ve 24. satırlardaki 22 yerine y yazdım
birde en sona
126. satıra
next y yazdım.
sayfadaki 20 personelinde bilgisini alıyor fakat bu seferde extradan satırlar açıyor. bir sayfa için 1900-2200 arası satır açıyor bu satırların yanlızca 20 tanesi dolu. diğer sayfaya geçince yine aynı durum yani 2 sayfa veride nerdeyse 5000 satır açıyor. bunu nasıl engellerim?
Private Sub Komut128_Click()
On Error Resume Next
Dim IE As Object
Dim HTML_Body As Object, HTML_Tables As Object, MyTable As Object
Dim HTML_TableRows As Object
Dim RetVal As Variant, X, a, Y As Integer, SATIRSAYISI As Integer
For Y = 22 To 60 Step 2
Set IE = Me.WebBrowser1
Set HTML_Body = IE.Document.All
Set HTML_Tables = HTML_Body.tags("Table")
Set MyTable = HTML_Tables(Y)
Set HTML_TableRows = MyTable.GetElementsByTagName("tr")
'If IE.Document.All.tags("table").Item(Y).Rows(0).Cells(0).innerText <> RAPORADI.Caption Then
'DoCmd.OpenForm "RAPOR_UYARI"
'Else
For Each MyRow In HTML_TableRows
X = X + 1
Next
SATIRSAYISI = (X - 1) / 1 '(X - 10) / 2
ReDim Sorgu(10, SATIRSAYISI - 1)
X = 0
For X = 0 To SATIRSAYISI - 1
a = 0 + (1 * X)
Sorgu(X, 0) = MyTable.Rows(a).Cells(1).innerText
Sorgu(X, 1) = MyTable.Rows(a).Cells(1).innerText
Sorgu(X, 2) = MyTable.Rows(a).Cells(1).innerText
Sorgu(X, 3) = MyTable.Rows(a).Cells(1).innerText
Sorgu(X, 4) = MyTable.Rows(a).Cells(1).innerText
Sorgu(X, 5) = MyTable.Rows(a).Cells(1).innerText
Sorgu(X, 6) = MyTable.Rows(a).Cells(1).innerText
Sorgu(X, 7) = MyTable.Rows(a).Cells(1).innerText
Sorgu(X, 8) = MyTable.Rows(a).Cells(1).innerText
Sorgu(X, 9) = MyTable.Rows(a).Cells(1).innerText
Next X
strSQL = "SELECT * FROM PORTAL "
Set rstkayit = New ADODB.Recordset
rstkayit.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
X = 0
For X = 0 To SATIRSAYISI - 1
With rstkayit
.Find "[SICIL]='" & Sorgu(1, X) & "'"
If Not rstkayit.EOF Then
'If MsgBox("" & Sorgu(0, X) & " . AY VERİSİ DAHA ÖNCEDEN KAYIT EDİLMİŞ.Metin Güncellensin mi?", 51, "Kaydediliyor....") = 6 Then
.Fields("ADI") = Sorgu(0, X)
.Fields("SICIL") = Sorgu(1, X)
.Fields("UNVAN") = Sorgu(2, X)
.Fields("GOREVISYERI") = Sorgu(3, X)
.Fields("MAKAM") = Sorgu(4, X)
.Fields("BASKANLIK") = Sorgu(5, X)
.Fields("MUDURLUK") = Sorgu(6, X)
.Fields("SEFLIK") = Sorgu(7, X)
.Fields("ISYERI") = Sorgu(8, X)
.Fields("DAHILI") = Sorgu(9, X)
.Fields("MAIL") = Sorgu(10, X)
.Update
' Else
' Exit Sub
' End If
Else
.AddNew
.Fields("ADI") = Sorgu(0, X)
.Fields("SICIL") = Sorgu(1, X)
.Fields("UNVAN") = Sorgu(2, X)
.Fields("GOREVISYERI") = Sorgu(3, X)
.Fields("MAKAM") = Sorgu(4, X)
.Fields("BASKANLIK") = Sorgu(5, X)
.Fields("MUDURLUK") = Sorgu(6, X)
.Fields("SEFLIK") = Sorgu(7, X)
.Fields("ISYERI") = Sorgu(8, X)
.Fields("DAHILI") = Sorgu(9, X)
.Fields("MAIL") = Sorgu(10, X)
.Update
End If
End With
Next
Set rstkayit = Nothing
Me![PERSONEL_alt_formu].Requery
GoTo SafeExit:
'ErrHandler:
SafeExit:
Set HTML_Body = Nothing
Set HTML_Tables = Nothing
Set MyTable = Nothing
Set HTML_TableRows = Nothing
Set HTML_TableDivisions = Nothing
Set IE = Nothing
Next Y
'End If
End Sub
