AccessTr.neT

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.

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

sayfaya ait Html kodlarını eklerseniz yardımcı olmaya çalışırım.

Bu problem ile ilgili örnek uygulamanızı ekleyiniz.

kadirdursun

kadirdursun

ozanakkaya

ozanakkaya