web browser içindeki tabloyu almak?

[pitsss]

arkadaşlar kolay gelsin.
web browser kullanarak sayfadan veri alıyorum. sayfa üzerinde bi kaç formu otomatik doldurduktan sonra, butona otomatik basıyorum( makro ile)
karşıma gelen sayfadan da
şu şekilde e1 hücresine verileri alıyorum.

oResultPage = WebBrowser1.Document.body.innerHTML
    Sheets("sayfa1").Range("e1").Value = oResultPage

ama gördüğünüz gibi sayfanın tamamını alıyor. ( body olduğu için)
ama ben sadece table1 id ye sahip tablonun içindeki verileri alsın istiyorum ama bi türlü yapaamdım.
nasıl bir yol izlemem gerekli acaba?

body yerine ;
table
webtables
td
tr
bunları kullandım ama başarılı olamadım.
nasıl istediğim tablonun hepsini istediğim hücrelere yazdırabilirim.
şimdiden teşekkürler.

 

[Kemal Demir]

Web adresini soylemenızde sakınca yoksa ve aynı zamanda dosyanızı paylasırsanız daha erken ve doğru cozumler verilebilir.

 

[pitsss]

Web adresini soylemenızde sakınca yoksa ve aynı zamanda dosyanızı paylasırsanız daha erken ve doğru cozumler verilebilir.

dosya ekledim.
teşekkürler.

 

[Kemal Demir]

Merhaba,

Application.DisplayAlerts = False
 Dim IE As Object
 Dim HTML_Body As Object, MyTable As Object
 Dim alan As String
            alan = "http://wuhmuq.bay.livefilestore.com/y1p9AHfo1Q3YzWbI-B9q6kqIBsLJTdL9EmgaREUSabiLcHN2FhnRK7zEVIdUOhgoP7Q1X6nJ8qWxwfgKURUbAmYHw/deneme.html.htm"
            url = alan
            DoEvents: DoEvents
            With WebBrowser1
        .Navigate url
        .Visible = True
        DoEvents: DoEvents: DoEvents: DoEvents: DoEvents
        Do Until WebBrowser1.ReadyState = 4: DoEvents: Loop
        With .Document.all
            End With
        On Error Resume Next
        Do Until WebBrowser1.ReadyState = 4: DoEvents: Loop
        Do While WebBrowser1.Busy: DoEvents: Loop
        Set HTML_Body = WebBrowser1.Document.GetElementsByTagName("Body").Item(0)
        Set HTML_Tables = HTML_Body.GetElementsByTagName("Table")
        On Error Resume Next
        DoEvents: DoEvents: DoEvents: DoEvents: DoEvents
        DoEvents: DoEvents: DoEvents: DoEvents: DoEvents
        For c = 4 To 4
            Set MyTable = HTML_Tables(c)
            son = Sheets("data").[a65536].End(3).Row + 1
            Cells(son, 1) = MyTable.Rows(1).Cells(0).InnerText
           Next
    DoEvents: DoEvents: DoEvents: DoEvents: DoEvents
    DoEvents: DoEvents: DoEvents: DoEvents: DoEvents
    End With
    Set HTML_Body = Nothing
    Set HTML_Tables = Nothing
    Set MyTable = Nothing

Ben 4'un table ı alıyorum siz isteğinize göre seçebilirsiniz.

 

[pitsss]

Merhaba,

Application.DisplayAlerts = False
 Dim IE As Object
 Dim HTML_Body As Object, MyTable As Object
 Dim alan As String
            alan = "http://wuhmuq.bay.livefilestore.com/y1p9AHfo1Q3YzWbI-B9q6kqIBsLJTdL9EmgaREUSabiLcHN2FhnRK7zEVIdUOhgoP7Q1X6nJ8qWxwfgKURUbAmYHw/deneme.html.htm"
            url = alan
            DoEvents: DoEvents
            With WebBrowser1
        .Navigate url
        .Visible = True
        DoEvents: DoEvents: DoEvents: DoEvents: DoEvents
        Do Until WebBrowser1.ReadyState = 4: DoEvents: Loop
        With .Document.all
            End With
        On Error Resume Next
        Do Until WebBrowser1.ReadyState = 4: DoEvents: Loop
        Do While WebBrowser1.Busy: DoEvents: Loop
        Set HTML_Body = WebBrowser1.Document.GetElementsByTagName("Body").Item(0)
        Set HTML_Tables = HTML_Body.GetElementsByTagName("Table")
        On Error Resume Next
        DoEvents: DoEvents: DoEvents: DoEvents: DoEvents
        DoEvents: DoEvents: DoEvents: DoEvents: DoEvents
        For c = 4 To 4
            Set MyTable = HTML_Tables(c)
            son = Sheets("data").[a65536].End(3).Row + 1
            Cells(son, 1) = MyTable.Rows(1).Cells(0).InnerText
           Next
    DoEvents: DoEvents: DoEvents: DoEvents: DoEvents
    DoEvents: DoEvents: DoEvents: DoEvents: DoEvents
    End With
    Set HTML_Body = Nothing
    Set HTML_Tables = Nothing
    Set MyTable = Nothing

Ben 4'un table ı alıyorum siz isteğinize göre seçebilirsiniz.

cevabınız için çok teşekkürler.
acaba her hücreye her bir değeri atayacak şekilde nasıl yapabiliriz acaba?
yani

000002008016773454
  
  
 000002008016773454 nolu proje için randevu mevcuttur!
 
000002008016773455
  
  
 000002008016773455 nolu proje için randevu mevcuttur!
 
000002008016773460
  
  
 000002008016773460 nolu proje için randevu mevcuttur!
 
000002008016773488
  
  
 000002008016773488 nolu proje için randevu mevcuttur!

bu değerlerin her bir grubu ayrı bir hücre de nasıl oalbilir acaba?
teşekkürler

 

[Kemal Demir]

Sub splitayir()
For c = 2 To [a65536].End(3).Row
 'vbCrLf=ALT eNTER
 'split(arr,vbcrlf)
cumledeki_degerler = Split(Cells(c, 1), vbCrLf)
For i = 0 To UBound(cumledeki_degerler)
son = [e65536].End(3).Row + 1
Cells(son, i + 2) = cumledeki_degerler(i)
Next
Next
End Sub

Yukarıdaki kod işinizi görebilir düşüncesindeyim.

NOT:Test edilmedi.