Web'den Veri Çekme

[aLp59]

Arkadaşlar merhaba,

İnternetten koşula göre veri çekmek istiyorum.

Ekte anlatmaya çalıştım, yardımcı olursanız sevinirim.


Teşekkürler

 

[Mahmut Kök]

Döngü kurmuşsunuz ama sürekli aynı hücreden veri almışsınız.

mlz = Range("A2")

yazdığınız yeri

mlz = cells(i,"A")

şeklinde değiştirip deneyebilirisiniz. Stok yazdığınız yerde de aynı değişikliği yapmanız gerekir.

 

[aLp59]

Mahmut Bey,

Ekteki hatayı alıyorum.

Nasıl düzeltebilirim.

 

[Mahmut Kök]

Kodlarınızı aşağıdaki şekilde kullanabilirsiniz; ancak birkaç kullanımdan sonra internet sitesi insan doğrulaması yapmaya başlıyor. Bu durumda veri alamazsınız.

Sub kitapsec()


Dim ie As New InternetExplorer
ie.Visible = false 'Tüm veriler sıfır olarak geliyorsa insan doğrulaması olup olmadığını görmek için bu değeri TRUE yapın.

For i = 2 To 11
On Error GoTo kac
mlz = Cells(i, "A")

If (Trim(mlz)) = "" Then
    GoTo kac
End If


ie.navigate "https://www.tti.com/content/ttiinc/en/apps/part-detail.html?partsNumber=" & mlz

Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE

Dim doc As HTMLDocument
Set doc = ie.document

Set nesne = doc.getElementsByClassName("c-part-detail__available-number")(0)


If (nesne Is Nothing) Then
    stok = 0 'Ürün stokta yok.
Else

    If (Len(Trim(nesne.innerText)) = 0) Then
    stok = 0
    Else
    stok = nesne.innerText
    End If
      
End If

    Cells(i, "B") = stok

kac:
Next i

ie.Quit

    MsgBox ("İşlem tamamlandı.")

End Sub

 

[aLp59]

Hocam çok teşekkür ederim.

Bu bile işimi görür

 

[rabbace]

Merhaba,

https://www.turkiyeshell.com/pompatest/History.aspx bu linkten, gireceğim tarih aralığında / ya da günlük olarak Kocaeli - Merkez yakıt fiyatlarını çekmek istiyorum. Nasıl yapabilirim, yardımcı olabilir misiniz?

Konuya hakim olmadığım için ChatGPT'ye kod yazdırdım, aşağıdakileri verdi ama aşağıdaki kodlar çalışmıyor. Yardımcı olabilir misiniz?

Çalışmayan kodlar;

 ' İl seçimini yap
    doc.getElementById("ctl00_ContentPlaceHolder1_ddlCity").Value = "41" ' Kocaeli'nin il kodu

    ' İlçe seçimini yap
    doc.getElementById("ctl00_ContentPlaceHolder1_ddlTown").Value = "0001" ' Merkez ilçenin kodu

    ' Yakıt fiyatlarının bulunduğu tabloyu seç
    Set fiyatlar = doc.getElementById("ctl00_ContentPlaceHolder1_rptPriceList_ctl00_divTable")

Tüm kodlar;

Sub YakitFiyatlariCek()
    Dim IE As Object
    Dim doc As Object
    Dim fiyatlar As Object
    Dim i As Integer
    
    ' Internet Explorer'ı başlat
    Set IE = CreateObject("InternetExplorer.Application")
    
    ' IE penceresini gizli hale getir
    IE.Visible = False
    
    ' Web sayfasını aç
    IE.navigate "https://www.turkiyeshell.com/pompatest/History.aspx"
    
    ' Sayfanın yüklenmesini bekle
    Do While IE.Busy Or IE.readyState <> 4
        DoEvents
    Loop
    
    ' HTML belgesini al
    Set doc = IE.document
    
    ' İl seçimini yap
    doc.getElementById("ctl00_ContentPlaceHolder1_ddlCity").Value = "41" ' Kocaeli'nin il kodu
    
    ' İlçe seçimini yap
    doc.getElementById("ctl00_ContentPlaceHolder1_ddlTown").Value = "0001" ' Merkez ilçenin kodu
    
    ' Yakıt fiyatlarının bulunduğu tabloyu seç
    Set fiyatlar = doc.getElementById("ctl00_ContentPlaceHolder1_rptPriceList_ctl00_divTable")
    
    ' Tablodaki her satırı döngüyle gezip fiyatları al
    For i = 1 To fiyatlar.Children(0).Children.Length - 1
        ' İlgili hücreleri al
        Dim tarih As String
        Dim benzin As String
        Dim motorin As String
        
        tarih = fiyatlar.Children(0).Children(i).Children(0).innerText
        benzin = fiyatlar.Children(0).Children(i).Children(1).innerText
        motorin = fiyatlar.Children(0).Children(i).Children(2).innerText
        
        ' Alınan fiyatları istediğiniz şekilde kullanabilirsiniz, örneğin hücrelere yazdırabilirsiniz
        ' Örneğin A2 hücresine tarih, B2 hücresine benzin fiyatını yazdıralım
        Range("A" & i + 1).Value = tarih
        Range("B" & i + 1).Value = benzin
        Range("C" & i + 1).Value = motorin
    Next i
    
    ' Internet Explorer'ı kapat
    IE.Quit
    
    ' Bellekten temizle
    Set IE = Nothing
    Set doc = Nothing
    Set fiyatlar = Nothing
    
    MsgBox "Yakıt fiyatları başarıyla çekildi!"
End Sub