Soru Webden veri alma

[ptcsite]

Public Sub fintables()

Dim XMLreq As New MSXML2.XMLHTTP60
Dim HTMLdoc As New MSHTML.HTMLDocument
Dim baglan As String
Dim a As Integer

baglan = "https://fintables.com/son-bilancolar"

        XMLreq.Open "get", baglan, False
        XMLreq.send

            If XMLreq.Status <> 200 Then

            On Error Resume Next
            MsgBox "Sayfa Bulunamıyor", vbOKOnly

            End If

        HTMLdoc.body.innerHTML = XMLreq.responseText

        For a = 2 To 250
        
    Sayfa1.Cells(a, 1) = HTMLdoc.getElementsByClassName("text-shared-brand-solid-02 font-bold text-sm").Item(a - 2).innetText
        On Error GoTo son:
    Sayfa1.Cells(a, 2) = HTMLdoc.getElementsByClassName("truncate text-foreground-03 text-xs")(a - 2).innerText

        Next
son:

End Sub

Fintables sitesinden yeni açıklanan bilanço isimleri excele çekmeye çalışıyorum ama;
Sayfa1.Cells(a, 1) = HTMLdoc.getElementsByClassName("text-shared-brand-solid-02 font-bold text-sm").Item(a - 2).innetText

yukarıdaki kodda object tanım hatası veriyor. çözemedim nedne olduğunu. Yardımcı olurmusunuz. Excell dosyası da mevcut

 

[CengizYurek]

Site bir api yardımıyla son bilançolar kısmını oluşturuyor. Aşağıdaki linki sayfada bulunan apiyle kullanabiliyor.

api.fintables.com/screener/?period=2023/12&filter=published_at||!kapanis||!gunluk_getiri||!piyasa_degeri||!net_kar||!yillik_net_kar_degisimi||!fk||!pddd||

Kodunu Debug.Print ile denedim. Immediate'de baktığımda maalesef HTML kodlarının sadece site tarafından belirlenen bir kısmı geliyor. Bir nevi iframe gibi çalışıyor. Dolayısıyla senin çekmek istediğin class adı yukarda verdiğim linkte bulunduğu için son-bilancolar sayfasından çekilemiyor. Ne yaptıysam ilerleyemedim.

 

[ptcsite]

Cengiz bey ilginiz alakanız için çok teşekkür ederim bu bilgi bana yeterli...

Birde şu linke bakarmısınız bu da mı öyle?

KAP

www.kap.org.tr

 

[CengizYurek]

Cengiz bey ilginiz alakanız için çok teşekkür ederim bu bilgi bana yeterli...

Birde şu linke bakarmısınız bu da mı öyle?

KAP

www.kap.org.tr

Durum aynı.
Kodları almamız engelleniyor. POST yöntemiyle denedim ancak aşağıdaki kodları alabildim sadece.

{{memberVm.disclosures.length - $index}}
{{d.publishDate}}
{{d.stockCodes}}
{{d.kapTitle}}
{{d.disclosureClass}} ÖDA
{{d.subject}}
{{d.summary}}
{{d.relatedStocks}}
{{d.year}}
{{d.ruleTypeTerm}}

 

[ptcsite]

Son bir soru cengiz bey başka bir yöntem ile almaya çalışacağım:

Option Explicit
Public Sub deneme()

Dim XMLreq As New MSXML2.XMLHTTP60
Dim HTMLdoc As New MSHTML.HTMLDocument
Dim acik_url As New MSHTML.HTMLDocument
Dim baglan, baglanti, baglanti2, FR As String
Dim a, i As Integer


baglan = "https://www.kap.org.tr/tr/Bildirim/" & 1243379

        XMLreq.Open "get", baglan, False
        XMLreq.send

            If XMLreq.Status <> 200 Then

            On Error Resume Next
            MsgBox "Veriler Toplandı", vbOKOnly
            GoTo son:
            End If

        HTMLdoc.body.innerHTML = XMLreq.responseText

    baglanti = HTMLdoc.getElementsByClassName("type-medium bi-sky-black")(1).innerText
    baglanti2 = HTMLdoc.getElementsByClassName("type-medium bi-sky-black")(2).innerText
    Sayfa1.Cells(1, 1) = Left(Right(baglanti, Application.WorksheetFunction.Find(" ", baglanti, 1) + 2), 4)
    Sayfa1.Cells(1, 2) = Left(baglanti2, 2)
    FR = "FR"
If Sayfa1.Cells(1, 1) = Format(Now, "yyyy") And Sayfa1.Cells(1, 2) = FR Then
    Sayfa1.Cells(1, 3) = HTMLdoc.getElementsByClassName("type-medium bi-dim-gray")(0).innerText
    Else
    GoTo son:

End If

'Buraya for döngüsü yapılacak bağlan i ye göre değişken olarak link kontrolü yapılacak
son:

End Sub

Kodumuz basit bir şekilde yaptım ama bunda if döngüsündeki eşitliği tanımadığından makro sonlanıyor.
Sorun: if döngüsünde verileri tanımıyor .. Yani A1 hücresine 2024 yazdırıyorum B1 hücresine FR yazdırıyorum... Eğer bu hücreler eşitse şunu yap diyorum ama eşit olarak algılamıyor halbuki eşitler...

makro dosyasını ekledim...

Not: Sorunu çözdüm

If Sayfa1.Cells(1, 1).Text= Format(Now, "yyyy") And Sayfa1.Cells(1, 2) = FR Then

yapınca oldu

 

[Haluk]

Aslında, resimde belirttiğim URL'e doğru dürüst POST edebilsem, veriler alınacak ama .... ben de yapamadım.




.

 

[ptcsite]

selenium kullanmadan bunu yapabilen herhalde her siteden veriyi rahat çeker

 

[CengizYurek]

Son bir soru cengiz bey başka bir yöntem ile almaya çalışacağım:

Option Explicit
Public Sub deneme()

Dim XMLreq As New MSXML2.XMLHTTP60
Dim HTMLdoc As New MSHTML.HTMLDocument
Dim acik_url As New MSHTML.HTMLDocument
Dim baglan, baglanti, baglanti2, FR As String
Dim a, i As Integer


baglan = "https://www.kap.org.tr/tr/Bildirim/" & 1243379

        XMLreq.Open "get", baglan, False
        XMLreq.send

            If XMLreq.Status <> 200 Then

            On Error Resume Next
            MsgBox "Veriler Toplandı", vbOKOnly
            GoTo son:
            End If

        HTMLdoc.body.innerHTML = XMLreq.responseText

    baglanti = HTMLdoc.getElementsByClassName("type-medium bi-sky-black")(1).innerText
    baglanti2 = HTMLdoc.getElementsByClassName("type-medium bi-sky-black")(2).innerText
    Sayfa1.Cells(1, 1) = Left(Right(baglanti, Application.WorksheetFunction.Find(" ", baglanti, 1) + 2), 4)
    Sayfa1.Cells(1, 2) = Left(baglanti2, 2)
    FR = "FR"
If Sayfa1.Cells(1, 1) = Format(Now, "yyyy") And Sayfa1.Cells(1, 2) = FR Then
    Sayfa1.Cells(1, 3) = HTMLdoc.getElementsByClassName("type-medium bi-dim-gray")(0).innerText
    Else
    GoTo son:

End If

'Buraya for döngüsü yapılacak bağlan i ye göre değişken olarak link kontrolü yapılacak
son:

End Sub

Kodumuz basit bir şekilde yaptım ama bunda if döngüsündeki eşitliği tanımadığından makro sonlanıyor.
Sorun: if döngüsünde verileri tanımıyor .. Yani A1 hücresine 2024 yazdırıyorum B1 hücresine FR yazdırıyorum... Eğer bu hücreler eşitse şunu yap diyorum ama eşit olarak algılamıyor halbuki eşitler...

makro dosyasını ekledim...

Normalde herşey çalışıyor sıkıntı yok. Fakat POST etmemizi engelliyor site. Biz excel'de değişkeni döndürürken sitenin güvenlik duvarına takılıyoruz. Genelde webmaster arkadaşlarımız bunu aşmak için sayfa içine sayfayı gerekirse javascript kullanarak iframe gibi ama html kullanmadan yapıyorlar.

Size bir fikir verebilir diye şöyle bir tavsiye de bulunabilirim.
Veri çekmek istediğiniz sayfayı farklı kaydet ile masaüstüne indirin. Sonra excel ile o sayfadan istediğin veriyi çekmeyi deneyin. Biraz otomatik biraz manuel olacak ancak sanırım işe yarayacak tek yöntem bu gibi.