Skip to main content

AccessTr.neT


webden veri alırken değişken tablolar?

kadirdursun
kadirdursun
3
2539

webden veri alırken değişken tablolar?

#1
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 Img-grin 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.
Hayat bu
ölsende yaşamaya mecbursun!
UNUTMA!!!



(hafta sonu mesai olmadığından mesajlardaki çözümleri ancak hafta içi uygulayabiliyorum)
Son Düzenleme: 28/08/2012, 11:39, Düzenleyen: kadirdursun.
Cevapla
#2
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


Hayat bu
ölsende yaşamaya mecbursun!
UNUTMA!!!



(hafta sonu mesai olmadığından mesajlardaki çözümleri ancak hafta içi uygulayabiliyorum)
Son Düzenleme: 28/08/2012, 13:07, Düzenleyen: kadirdursun.
Cevapla
#3
sayfaya ait Html kodlarını eklerseniz yardımcı olmaya çalışırım.
Cevapla
#4
Bu problem ile ilgili örnek uygulamanızı ekleyiniz.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task