Web' den tablo verisi çekme

[tamer42]

Merhabalar,
Internet explorer' da ekli linkten tabloları kopyalarken; her bir tabloya ait "Copy" butonu mevcut;
https://core.aiesec.org.eg/analytics/1563/LC21/

yalnız bu copy butonlarına dair ClassName' lerin heps "col-sm-6" olarak görünüyor, her bir tablo için ayrımı nasıl yapabiliriz, yani istediğimi tabloyu çekmek için nasıl bir düzenleme yapmak gerekir.

Set doc = ie.document
  ss = Sayfa1.Cells(Sayfa1.Rows.Count, "A").End(xlUp).Row

 For Each oelt2 In doc.getElementsByClassName("col-sm-6")(0).getElementsByTagName("span")
            If oelt2.innerText Like "Copy" Then oelt2.Click
           Application.Wait (Now + TimeValue("00:00:01"))
            Sayfa1.Range("A" & ss + 2).Select
            ActiveSheet.Paste
            

         ss = Sayfa1.Cells(Sayfa1.Rows.Count, "A").End(xlUp).Row
         
Next oelt2

yardımlarınız için şimdiden teşekkürler,
iyi çalışmalar.

 

[halit3]

bu kodu bir dene

Private Sub CommandButton1_Click()
Dim URL As String
Dim IE As Object
Dim oelt2 As Object

URL = "https://core.aiesec.org.eg/analytics/1563/LC21/"
Set IE = CreateObject("InternetExplorer.Application")

With IE
.navigate URL
.Visible = 1
Do Until IE.readyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop

ss = Sayfa1.Cells(Sayfa1.Rows.Count, "A").End(xlUp).Row
For Each oelt2 In IE.Document.getElementsByTagName("a")
If oelt2.innerText Like "Copy" Then

oelt2.Click
Application.Wait (Now + TimeValue("00:00:01"))
Sayfa1.Range("A" & ss + 2).Select
ActiveSheet.Paste
ss = Sayfa1.Cells(Sayfa1.Rows.Count, "A").End(xlUp).Row
End If
Next oelt2
IE.Quit: Set IE = Nothing
End With
MsgBox ("Bitti  ")
End Sub

 

[tamer42]

bu kodu bir dene

Private Sub CommandButton1_Click()
Dim URL As String
Dim IE As Object
Dim oelt2 As Object

URL = "https://core.aiesec.org.eg/analytics/1563/LC21/"
Set IE = CreateObject("InternetExplorer.Application")

With IE
.navigate URL
.Visible = 1
Do Until IE.readyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop

ss = Sayfa1.Cells(Sayfa1.Rows.Count, "A").End(xlUp).Row
For Each oelt2 In IE.Document.getElementsByTagName("a")
If oelt2.innerText Like "Copy" Then

oelt2.Click
Application.Wait (Now + TimeValue("00:00:01"))
Sayfa1.Range("A" & ss + 2).Select
ActiveSheet.Paste
ss = Sayfa1.Cells(Sayfa1.Rows.Count, "A").End(xlUp).Row
End If
Next oelt2
IE.Quit: Set IE = Nothing
End With
MsgBox ("Bitti  ")
End Sub

Halit hocam ilginize teşekkürler,
Ben tam anlatamadım galiba; ben tüm tabloları değil de, seçim yaparak sepesifik bir tabloyu çekmek istiyorum.
Örnek: sadece en üstte yer alan (1. sırada) tabloyu çekmek istersek nasıl bir düzenleme yapmak gerekir?

iyi çalışmalar.

 

[Mahmut Kök]

Üst id'leri kullanarak yapabilirsiniz. Aşağıdaki kodları deneyin. 2 tabloyu da kopyalayacaktır. Almak istemediğinizi çıkarıp kodları ona göre düzenleyebilirsiniz.

Dim idler(1) As String

idler(0) = "signups-table_wrapper"
idler(1) = "conversions-table_wrapper"

For Each idm In idler

    For Each oelt2 In doc.all(idm).getElementsByClassName("col-sm-6")(0).getElementsByTagName("span")
   
                If oelt2.innerText Like "Copy" Then
                    oelt2.Click
                   
                    Application.Wait (Now + TimeValue("00:00:01"))
                    Sayfa1.Range("A" & ss + 2).Select
                    ActiveSheet.Paste
                   
       
                    ss = Sayfa1.Cells(Sayfa1.Rows.Count, "A").End(xlUp).Row
                    Exit For
                End If
   
    Next

Next

 

[tamer42]

Üst id'leri kullanarak yapabilirsiniz. Aşağıdaki kodları deneyin. 2 tabloyu da kopyalayacaktır. Almak istemediğinizi çıkarıp kodları ona göre düzenleyebilirsiniz.

Dim idler(1) As String

idler(0) = "signups-table_wrapper"
idler(1) = "conversions-table_wrapper"

For Each idm In idler

    For Each oelt2 In doc.all(idm).getElementsByClassName("col-sm-6")(0).getElementsByTagName("span")
  
                If oelt2.innerText Like "Copy" Then
                    oelt2.Click
                  
                    Application.Wait (Now + TimeValue("00:00:01"))
                    Sayfa1.Range("A" & ss + 2).Select
                    ActiveSheet.Paste
                  
      
                    ss = Sayfa1.Cells(Sayfa1.Rows.Count, "A").End(xlUp).Row
                    Exit For
                End If
  
    Next

Next

Çok teşekkürler Mahmut Hocam