Soru Web sitesinden bilgi nasıl alınır

Katılım
17 Haziran 2008
Mesajlar
1,840
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
Merhaba arkadaşlar;

bir web sitesinde bilgi nasıl alınır, örnekle açıklayabilirmisiniz ?

Msgbox ile bilgi vermesi yeterlidir.


örnek site : http://www.demirfiyatlari.com/

Bugün Tarihli:

Q8mm Q10mm Q12mm ve Q32 arası

yardımıcı arkadaşa şimdiden Teşekkür ederim.
 

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,591
Excel Vers. ve Dili
Pro Plus 2021
Kod:
Private Sub CommandButton1_Click()
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "http://www.demirfiyatlari.com/"
    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = CreateObject("htmlFile")
    HTML.body.innerhtml = objHTTP.responseText

    Set List = HTML.GetElementById("list")
    Set div = List.GetElementsByTagName("DIV")
    baslik = div(0).innertext
   
    Dim sutunlar(0 To 11, 0 To 3)
   
    Set th = List.GetElementsByTagName("TH")
    For i = 0 To 3
        sutunlar(0, i) = th(i).innertext
    Next i

    Set tbody = List.GetElementsByTagName("TBODY")
    Set tr = tbody(0).GetElementsByTagName("Tr")
    For i = 0 To 10
        Set td = tr(i).GetElementsByTagName("TD")
        For ii = 0 To 3
            sutunlar(i + 1, ii) = td(ii).innertext & vbTab
        Next ii
    Next i
   
    Set objHTTP = Nothing
    Set HTML = Nothing
    Set List = Nothing
    Set div = Nothing
    Set th = Nothing
    Set tbody = Nothing
    Set tr = Nothing
    Set td = Nothing

    ListBox1.List = sutunlar
    Label1.Caption = baslik
End Sub
https://yadi.sk/d/ytXVxEZNTsZlgQ
 

Ekli dosyalar

Son düzenleme:
Katılım
17 Haziran 2008
Mesajlar
1,840
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
veyselemre;

Hocam kod için teşekkür ederim.

Tabloyu indiremedim. başka bir paylaşım linki verebilirmisiniz ? bir de bu kodlarla ilgili sorum olacak.
 
Katılım
17 Haziran 2008
Mesajlar
1,840
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
Kod:
Private Sub CommandButton1_Click()
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "http://www.demirfiyatlari.com/"
    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = CreateObject("htmlFile")
    HTML.body.innerhtml = objHTTP.responseText

    Set List = HTML.GetElementById("list")
    Set div = List.GetElementsByTagName("DIV")
    baslik = div(0).innertext
   
    Dim sutunlar(0 To 11, 0 To 3)
   
    Set th = List.GetElementsByTagName("TH")
    For i = 0 To 3
        sutunlar(0, i) = th(i).innertext
    Next i

    Set tbody = List.GetElementsByTagName("TBODY")
    Set tr = tbody(0).GetElementsByTagName("Tr")
    For i = 0 To 10
        Set td = tr(i).GetElementsByTagName("TD")
        For ii = 0 To 3
            sutunlar(i + 1, ii) = td(ii).innertext & vbTab
        Next ii
    Next i
   
    Set objHTTP = Nothing
    Set HTML = Nothing
    Set List = Nothing
    Set div = Nothing
    Set th = Nothing
    Set tbody = Nothing
    Set tr = Nothing
    Set td = Nothing

    ListBox1.List = sutunlar
    Label1.Caption = baslik
End Sub
https://yadi.sk/d/ytXVxEZNTsZlgQ

Hocam kod için teşekkürler. Ama bu şekilde değil. Mesaj olarak alacağız. Ve fiyatı en düşük olanları.
 
Katılım
17 Haziran 2008
Mesajlar
1,840
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
Kod:
Private Sub CommandButton1_Click()
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "http://www.demirfiyatlari.com/"
    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = CreateObject("htmlFile")
    HTML.body.innerhtml = objHTTP.responseText

    Set List = HTML.GetElementById("list")
    Set div = List.GetElementsByTagName("DIV")
    baslik = div(0).innertext
  
    Dim sutunlar(0 To 11, 0 To 3)
  
    Set th = List.GetElementsByTagName("TH")
    For i = 0 To 3
        sutunlar(0, i) = th(i).innertext
    Next i

    Set tbody = List.GetElementsByTagName("TBODY")
    Set tr = tbody(0).GetElementsByTagName("Tr")
    For i = 0 To 10
        Set td = tr(i).GetElementsByTagName("TD")
        For ii = 0 To 3
            sutunlar(i + 1, ii) = td(ii).innertext & vbTab
        Next ii
    Next i
  
    Set objHTTP = Nothing
    Set HTML = Nothing
    Set List = Nothing
    Set div = Nothing
    Set th = Nothing
    Set tbody = Nothing
    Set tr = Nothing
    Set td = Nothing

    ListBox1.List = sutunlar
    Label1.Caption = baslik
End Sub
https://yadi.sk/d/ytXVxEZNTsZlgQ

Hocam bu çalışmada ; ACCESS DENIED hatası alıyorum şu an...
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,302
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
http >>> https

.
 
Üst