epiaş sitesinden veri alma

H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Google Sheets ile çok hızlı alınabiliyor.....


Capture.PNG


.
 
Erdem Akdemir

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,633
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Haluk bey selamlar,

Google sheets olayına henüz başlayamadım.
Aşağıdaki kod ile verileri alıyorum ama nedense verimli olduğunu hissetmiyorum.

Kod: 
Sub epiass()
Dim isbn, Adres As String
Dim element As Object
Dim ie As New InternetExplorer
Dim doc As HTMLDocument
Dim Sht As Worksheet

Cells.Clear

Set Sht = ActiveSheet

FindAndTerminate "IExplore.exe"
Const MAX_WAIT_SEC As Long = 5

ie.Visible = False

Adres = "https://seffaflik.epias.com.tr/transparency/dogalgaz/stp/stp-grf.xhtml"

ie.navigate Adres

    Do While ie.readyState <> READYSTATE_COMPLETE Or ie.Busy
    DoEvents
    Loop

    Set doc = ie.document

Set deg = doc.getElementById("j_idt231:dt_data")

x = 2

Range("B:B").NumberFormat = "#,##0.00"

    For Each metin In deg.Children
   
       Cells(x, 1) = CDate(metin.Children.Item(0).innerText)
       Cells(x, 2) = metin.Children.Item(1).innerText * 1

        x = x + 1
    Next metin
   
    Range("A1") = "Gaz Günü"
       Range("B1") = "GRF"

Set arit = doc.getElementById("j_idt231:dt_foot")
     
      son = deg.Children.Length + 2
     
        Range("A" & son) = arit.Children.Item(0).Children.Item(0).innerText
        Range("B" & son) = arit.Children.Item(0).Children.Item(1).innerText * 1
        Range("A" & son & ":B" & son).Font.Bold = True
   
SafeExit:
ie.Quit

Set ie = Nothing

Range("A1:B1").Font.Bold = True

Range("B:B").NumberFormat = "#,##0.00"

Cells.EntireColumn.AutoFit

End Sub

Sub FindAndTerminate(ByVal strProcName As String)
    Dim objWMIService, objProcess, colProcess
    Dim strComputer, strList
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" _
    & strComputer & "\root\cimv2")
    Set colProcess = objWMIService.ExecQuery _
    ("Select * from Win32_Process Where Name = '" & strProcName & "'")
    If colProcess.Count > 0 Then
        For Each objProcess In colProcess
            objProcess.Terminate
        Next objProcess
    End If
End Sub
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Merhaba,

Artık XMLHTTP gibi performanslı nesneler varken, IE kullanmak istemiyor tabii kimse.

Ama, sunucular da kendi performansları düşmesin diye URL üzerinde yayınladıkları verilerin alınmasını artık iyice zorlaştırdılar. Bunun için ciddi yatırımlarla sayfalarını düzeniyorlar artık.

Fakat dediğim gibi, Google Sheets ile sıkıntılı yerlerden de veri alınabiliyor. Birçoğundan, basit bir formülle URL sayfasındaki tabloyu olduğu alabiliyorsunuz. Tıpkı, ilk mesajınızda verdiğiniz "epias" sitesi gibi.

Diğer yandan; Google Sheets'e aktarılan veriler daha sonra script ile JSon veya XML formatına çevrilip Web servis haline getirildikten sonra MS Excel VBA ile bu veriler XMLHTTP nesnesiyle alınabilir.

.
 
Son düzenleme:
veyselemre

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,646
Excel Vers. ve Dili
Pro Plus 2021
Merhaba,
Selenium basic kurulu olmalı ve referanslardan Selenium Type Library seçili olmalıdır.

Kod: 
Sub driverAc()

    Set driver = New ChromeDriver
    Set keys = New Selenium.keys
    ilkTar = CDate("2022-08-31")
    sonTar = CDate("2022-09-30")
    ilk = Format(ilkTar, "YYYY-M-D")
    son = Format(sonTar, "YYYY-M-D")
    With driver
        .AddArgument "--headless"
        .Get "https://seffaflik.epias.com.tr/transparency/service/stp/grf?period=DAILY&" & _
             "startDate=" & ilk & "&endDate=" & son
        .Timeouts.ImplicitWait = 50
        txt = .FindElementById("folder1").Text
        txt = "<xml>" & txt & "</xml>"
        .Quit
      
    End With
    
    Cells.ClearContents
    With CreateObject("Msxml2.DOMDocument")
        .LoadXML (txt)
    
        For Each p In .getElementsByTagName("prices")
            
            t = p.SelectSingleNode("gasDay").Text
            tar = CDate(Mid(t, 9, 2) & "." & Mid(t, 6, 2) & "." & Left(t, 4))
            If tar >= ilkTar And tar <= sonTar Then
                sat = sat + 1
                Cells(sat, 1).Value = tar
                Cells(sat, 2).Value = Val(p.SelectSingleNode("price").Text)
            End If
        Next p
    End With

End Sub
 
Erdem Akdemir

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,633
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Hazırladığım çalışmayı bende paylaşıyorum.
@veyselemre bey Selenium ilk kullandığımda hoşuma gitmişti ama driver güncellemesinden dolayı kullanmaktan vazgeçtim.

Kod: 
Sub epiass()
Dim isbn, Adres As String
Dim element As Object
Dim ie As New InternetExplorer
Dim doc As HTMLDocument
Dim Sht As Worksheet

Application.ScreenUpdating = False

If Range("E1") = "" Then MsgBox "E1 hücresine başlangıç tarihini giriniz.": Exit Sub
If Range("F1") = "" Then MsgBox "F1 hücresine bitiş tarihini giriniz.": Exit Sub
If Range("F1") < Range("E1") Then MsgBox "Bitiş tarihi, başlangıç tarihinden küçük olamaz.": Exit Sub

Range("A2:B" & Rows.Count).Clear

Set Sht = ActiveSheet

FindAndTerminate "IExplore.exe"

ie.Visible = False

Adres = "https://seffaflik.epias.com.tr/transparency/dogalgaz/stp/stp-grf.xhtml"

ie.navigate Adres

    Do While ie.readyState <> READYSTATE_COMPLETE Or ie.Busy
    DoEvents
    Loop

    Set doc = ie.document

doc.getElementById("j_idt231:date1_input").Value = Range("E1").Text
doc.getElementById("j_idt231:date2_input").Value = Range("F1").Text
doc.getElementsByClassName("ui-button-text ui-c")(0).Click

    Do While ie.readyState <> READYSTATE_COMPLETE Or ie.Busy
    DoEvents
    Loop

Set syf = doc.getElementsByClassName("ui-paginator-current")

s = Split(syf.Item(0).innertext, " ")

sayac = Replace(s(2), ")", "") * 1
x = 2

For xp = 1 To sayac

Set deg = doc.getElementById("j_idt231:dt_data")

Range("B:B").NumberFormat = "#,##0.00"

    For Each metin In deg.Children
   
       Cells(x, 1) = CDate(metin.Children.Item(0).innertext)
       Cells(x, 2) = metin.Children.Item(1).innertext * 1

        x = x + 1
    Next metin
   doc.getElementsByClassName("ui-icon ui-icon-seek-next")(0).Click
 
    Do While ie.readyState <> READYSTATE_COMPLETE Or ie.Busy
    DoEvents
    Loop
   
   basla = Timer: While (Timer - basla) < 1: Wend

Next xp
    Range("A1") = "Gaz Günü"
       Range("B1") = "GRF"

Set arit = doc.getElementById("j_idt231:dt_foot")
     
      son = Cells(Rows.Count, 1).End(3).Row + 1
     
        Range("A" & son) = arit.Children.Item(0).Children.Item(0).innertext
        Range("B" & son) = arit.Children.Item(0).Children.Item(1).innertext * 1
        Range("A" & son & ":B" & son).Font.Bold = True
   
SafeExit:
ie.Quit

Set ie = Nothing

'Range("A1:B1").Font.Bold = True
    With Range("A" & son & ":B" & son).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

Range("A:A").HorizontalAlignment = xlLeft

Range("B:B").NumberFormat = "#,##0.00"

Cells.EntireColumn.AutoFit

Application.ScreenUpdating = True
If Range("G1").Value = "OK" Then MsgBox "İşlem başarılı tamamlandı."
If Range("G1").Value = "HATA" Then
MsgBox "...İŞLEM HATALI..." & Chr("10") & "TEKRAR DENEYİNİZ."
Range("A2:B" & Rows.Count).Clear
End If
End Sub

Sub FindAndTerminate(ByVal strProcName As String)
    Dim objWMIService, objProcess, colProcess
    Dim strComputer, strList
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" _
    & strComputer & "\root\cimv2")
    Set colProcess = objWMIService.ExecQuery _
    ("Select * from Win32_Process Where Name = '" & strProcName & "'")
    If colProcess.Count > 0 Then
        For Each objProcess In colProcess
            objProcess.Terminate
        Next objProcess
    End If
End Sub
 

Ekli dosyalar

H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Son düzenleme:
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Yukarıdaki önerimde belirttiğim şekilde, verilerin XML tablosundan alınarak Excel'e aktarılması ekli dosyada yapılmıştır.

.
 

Ekli dosyalar

Erdem Akdemir

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,633
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
@Haluk bey elinize sağlık.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst