İnternetten akaryakıt fiyatları çekme hk.

[tamer42]

Merhabalar,

https://www.opet.com.tr/akaryakit-fiyatlari-arsivi
sitesinden aşağıdaki kod iiel akaryakıt fiyatları çekmek istediğimde web sitesi ekranında göründüğü gibi değil, ekli ekranda görüntüsünde olduğu gibi karışık bir yapıda gelmekte;

Tabloda sadece tarih ve fiyat bilgilerinin olduğu şekliyle nümerik bir formatta gelmesi için nasıl bir düzenleme yapmamız gerekecektir.

ilginiz için şimdiden teşekkürler,

iyi çalışmalar.

Sub Tablo_Al_Aktar14()
On Error Resume Next
Dim SH As Worksheet
Dim sh1 As Worksheet

Dim URL As String
Dim IE As New InternetExplorer
Dim doc As HTMLDocument
Dim btn As String
Dim Nesne As Object
Dim e As Object
Dim myCls As String
Dim strCls As String

Dim r As Long
Dim c As Byte

Dim htmldoc As MSHTML.HTMLDocument
Dim htmlTablo As MSHTML.IHTMLElement
Dim htmlTab As MSHTML.IHTMLElement
Dim htmlTablolar As MSHTML.IHTMLElementCollection
Dim htmlSatir As MSHTML.IHTMLElement
Dim htmlElaman As MSHTML.IHTMLElement

Application.DisplayAlerts = False

Set SH = Sheets("Data")
Set sh1 = Sheets("Sayfa4")

SH.Activate

URL = "https://www.opet.com.tr/akaryakit-fiyatlari-arsivi"
 
With IE
.Visible = True
.navigate URL

End With

Do
    DoEvents
    Loop Until IE.readyState = READYSTATE_COMPLETE

  
  Set htmldoc = IE.document
   
      
 Application.Wait (Now + TimeValue("00:00:02"))
 
 
 sh1.Activate
 sh1.Cells.Clear
 
r = 0
c = 1


Set htmlTablolar = htmldoc.getElementsByTagName("table")

For Each htmlTablo In htmlTablolar

strCls = "FuelPriceArchive-module_tableFuelPriceArchive--1kE table table-nowrap table-keyvalue table-small-head"

If htmlTablo.className = strCls Then

 r = r + 2
 
     For Each htmlSatir In htmlTablo.getElementsByTagName("tr")
  
c = 1

            For Each htmlElaman In htmlSatir.Children

                   sh1.Cells(r, c) = htmlElaman.innerText

                c = c + 1

            Next htmlElaman

        r = r + 1
    Next htmlSatir
  
  
 End If
 
 
Next htmlTablo


''sh1.Range("A:Z").EntireColumn.AutoFit

Set SH = Nothing
Set sh1 = Nothing

40:

Application.DisplayAlerts = True

IE.Quit

 Set htmldoc = Nothing
 
''Call DUZENLE
 
MsgBox "İşlem Tamam", vbInformation, "Bilgi"

End Sub

[code]

 

[veyselemre]

Sub opetAkaryakitFiyatListesiAl()
    
    Dim response$, url$, fiyatlar As Object, f As Object, ff As Object, _
    w(1 To 8), basTar$, sonTar$, idx%, itms, sut&
    url = "https://api.opet.com.tr/api/fuelprices/prices/archive?DistrictCode=934015&StartDate=basTarT00:00:00.0Z&EndDate=sonTarT00:00:00.0Z&IncludeAllProducts=true"
    basTar = "2022-12-01"
    sonTar = "2023-01-12"
    url = Replace(Replace(url, "basTar", basTar), "sonTar", sonTar)
    
    With CreateObject("Msxml2.ServerXMLHTTP.6.0")
        .Open "GET", url, False
        .send ""
        response = Replace(.responseText, "day", "tarih")
    End With

    Cells.ClearContents
    
    With CreateObject("MSScriptControl.ScriptControl")
        .Language = "JScript"
        Set fiyatlar = .Eval("(" & response & ")")
    End With

    With CreateObject("Scripting.Dictionary")
        Set f = CallByName(fiyatlar, "0", VbGet)
        
        w(1) = "Tarih"
        sut = 2
        For Each ff In f.prices
            w(sut) = ff.productName
            sut = sut + 1
        Next
        .Item(-1) = w
        
         For Each ff In fiyatlar
            w(1) = Split(ff.tarih, "T")(0)
            w(1) = DateSerial(Left(w(1), 4), Mid(w(1), 6, 2), Right(w(1), 2))
            idx = 2
            For Each f In ff.prices
                w(idx) = f.amount
                idx = idx + 1
            Next f
            .Item(.Count) = w
        Next ff
        
        itms = Application.Transpose(Application.Transpose(.items))
    End With
    Range("A1").Resize(UBound(itms), 8).Value = itms
    
    ActiveSheet.Columns.AutoFit
End Sub

 

[tamer42]

Sub opetAkaryakitFiyatListesiAl()
   
    Dim response$, url$, fiyatlar As Object, f As Object, ff As Object, _
    w(1 To 8), basTar$, sonTar$, idx%, itms, sut&
    url = "https://api.opet.com.tr/api/fuelprices/prices/archive?DistrictCode=934015&StartDate=basTarT00:00:00.0Z&EndDate=sonTarT00:00:00.0Z&IncludeAllProducts=true"
    basTar = "2022-12-01"
    sonTar = "2023-01-12"
    url = Replace(Replace(url, "basTar", basTar), "sonTar", sonTar)
   
    With CreateObject("Msxml2.ServerXMLHTTP.6.0")
        .Open "GET", url, False
        .send ""
        response = Replace(.responseText, "day", "tarih")
    End With

    Cells.ClearContents
   
    With CreateObject("MSScriptControl.ScriptControl")
        .Language = "JScript"
        Set fiyatlar = .Eval("(" & response & ")")
    End With

    With CreateObject("Scripting.Dictionary")
        Set f = CallByName(fiyatlar, "0", VbGet)
       
        w(1) = "Tarih"
        sut = 2
        For Each ff In f.prices
            w(sut) = ff.productName
            sut = sut + 1
        Next
        .Item(-1) = w
       
         For Each ff In fiyatlar
            w(1) = Split(ff.tarih, "T")(0)
            w(1) = DateSerial(Left(w(1), 4), Mid(w(1), 6, 2), Right(w(1), 2))
            idx = 2
            For Each f In ff.prices
                w(idx) = f.amount
                idx = idx + 1
            Next f
            .Item(.Count) = w
        Next ff
       
        itms = Application.Transpose(Application.Transpose(.items))
    End With
    Range("A1").Resize(UBound(itms), 8).Value = itms
   
    ActiveSheet.Columns.AutoFit
End Sub

Veysel Hocam çok teşekkürler,
emeğinize sağlık,
müsaadelerinizde bir şey daha sormak istiyorum.
Tablonun üstünde yer alan il ve ilçe seçimini nasıl yaptırabiliriz?

iyi Çalışmalar.

 

[veyselemre]

 

[tamer42]

Ekli dosyayı görüntüle 242075

Veysel hocam ilginize teşekkürler,
site açıldığı zaman, bu komutları nasıl verebileceğini yapamadım.

İL: ANKARA
İLÇE: ALTINDAĞ

seçimini kod nasıl yaptıtabiliriz? daha sonra veri çekme sürecine geçmemiz lazım.

    With CreateObject("Msxml2.ServerXMLHTTP.6.0")
        .Open "GET", url, False
        .send ""
        response = Replace(.responseText, "day", "tarih")
    End With

iyi Çalışmalar.

 

[veyselemre]

 

[tamer42]

Ekli dosyayı görüntüle 242077

Ekli dosyayı görüntüle 242078

Teşekkürler Veysel Hocam,
şimdi çözdüm olayı,

Burada yer alan Tüm "DisrictCode" listesini almanın bir yöntemi var mıdır?

Excel ortamında bir İl-İlçe tablosu yapmak isiyorum, burada oluşturacağım combobox üzerinden önce İL sonra İLÇE seçimi yapıp ona göre verileri getirmek istiyordum.
tekrar teşekkürler,
İyi Çalışmalar.

 

[beab05]

Merhaba;

İller için;

https://api.opet.com.tr/api/fuelprices/provinces

Bölgeler için;

https://api.opet.com.tr/api/fuelprices/provinces/934/districts

(934 İstanbul Avrupa yakası)

Bu linklerden gelen Json verilerden ilgili alanları alarak HTML request yapmak yerine kullanabilirsiniz. Excel ile alma konusunda diğer arkadaşlar yardımcı olur umarım. Benim Excel bilgim oldukça sınırlı..

Not: chrome için "JSONVue" eklentisini kurup yukarıdaki linklere girerseniz JSON verileri okunaklı şekilde görürsünüz. Kesinlikle tavsiye ederim.

 

[tamer42]

Merhaba;

İller için;

https://api.opet.com.tr/api/fuelprices/provinces

Bölgeler için;

https://api.opet.com.tr/api/fuelprices/provinces/934/districts

(934 İstanbul Avrupa yakası)

Bu linklerden gelen Json verilerden ilgili alanları alarak HTML request yapmak yerine kullanabilirsiniz. Excel ile alma konusunda diğer arkadaşlar yardımcı olur umarım. Benim Excel bilgim oldukça sınırlı..

Not: chrome için "JSONVue" eklentisini kurup yukarıdaki linklere girerseniz JSON verileri okunaklı şekilde görürsünüz. Kesinlikle tavsiye ederim.

teşekkür ederim, bana Tüm il ve ilçeler Code için gerekiyor, sanırım bunu yapmak biraz zor olacak