webden veri alırken değişken tablolar? - kadirdursun - 28/08/2012
konunun öncesi aşağıdaki linkde var.
https://accesstr.net/konu-webden-bilgi-alma.html
sayın ozanakkaya bu konuda çok yardımcı olmuştunuz. sorum şu aşağıdaki kodda veri almaya çalıştığım sitede personelin bilgileri bulunmakta. sayfalarca veri var ve her sayfada 20 personel sıralanmakta. Her personel için ayrı ayrı tablolar yapılmış. 1. personelin tablo nosu 22; ikincisi 24.... şeklinde 2 atlamalı gidiyor. tek personel için aşağıdaki kod çalışıyor. her seferinde tablo nosunu değiştirip veri almak çok akıllıca değil, elle yazmak daha kolay gelir aynı sayfada bulunan 20 personel içinde kodu çalıştırmam için nasıl bir döngü yapmalıyım?
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 As Integer, SATIRSAYISI As Integer
Set IE = Me.WebBrowser1
Set HTML_Body = IE.Document.All
Set HTML_Tables = HTML_Body.tags("Table")
Set MyTable = HTML_Tables(22)
Set HTML_TableRows = MyTable.GetElementsByTagName("tr")
If IE.Document.All.tags("table").Item(22).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
End If
End Sub
özür dilerim yanlış yere açmışım konuyu.
doğru yere tekrardan oluşturdum.
kusuruma bakmayın.
Cvp: webden veri alırken değişken tablolar? - kadirdursun - 28/08/2012
1. mesajdaki kodun 9. satırına y değişkeni ekledim.
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
Cvp: webden veri alırken değişken tablolar? - ozanakkaya - 05/09/2012
sayfaya ait Html kodlarını eklerseniz yardımcı olmaya çalışırım.
Cvp: webden veri alırken değişken tablolar? - ozanakkaya - 07/09/2012
Bu problem ile ilgili örnek uygulamanızı ekleyiniz.
|