AccessTr.neT

Bul · 28/08/2012, 11:36

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.

Bul · 28/08/2012, 13:05

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

Bul · 05/09/2012, 01:59

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

Bul · 07/09/2012, 17:42

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

AccessTr.neT

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

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

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

Giriş yap

Hesap oluştur

Konu Linkleri