Çözüldü EnPara Güncel Kur ve Altın bilgileri otomatik alma.

KoNFiCuS · 1 Nisan 2023

Merhaba Üstadlar,

Forumda arama yaptım ama eski konularda sadece sorgu ile çözümleri gördüm, Cebteteb için yapılmış olan macrolu bir çalışma mevcut bunun Enpara için çalışan versiyonu elinde olan var mı?

Teb için çalışan macro aşağıdadır bunu Enpara için değiştirebilir miyiz?

Kod:

Sub yenile_Hepsi()

'   Haluk - 12/03/2020
'   sa4truss@gmail.com
'

Dim objHTTP As Object, strURL As String, HTMLcode As String
    Dim arrHeaders()
    Dim i As Byte, j As Byte
    Dim tStart As Double, tEnd As Double
    Dim myMsg As String
   
    tStart = Timer
   
    Range("n9:q13") = ""
   
    Application.ScreenUpdating = False
   
    arrHeaders = Array("Altın", "CEPTETEB Alış", "CEPTETEB Satış", "Tarih")
    Range("N9:q9") = arrHeaders
   
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
   
    strURL = "https://www.cepteteb.com.tr/services/GetGunlukAltinKur"
   
    objHTTP.Open "GET", strURL, False
    objHTTP.setRequestHeader "Host", "www.cepteteb.com.tr"
    objHTTP.setRequestHeader "If-None-Match", "\zoru-basaririz-imkansiz-biraz-zaman-alir\"
    objHTTP.Send
   
    HTMLcode = objHTTP.responseText
   
    Set regExp = CreateObject("VBScript.RegExp")
   
    i = 10
    For j = 1 To UBound(Split(HTMLcode, "parakod"":"""))
            Cells(i, 14) = Split(Split(HTMLcode, "miktarBirim"":""")(j), """")(0)
            Cells(i, 15) = Split(Split(HTMLcode, "alisFiyat"":")(j), ",")(0)
            Cells(i, 16) = Split(Split(HTMLcode, "satisFiyat"":")(j), ",")(0)
            Cells(i, 17) = Split(Split(HTMLcode, "fiyatZaman"":""")(j), """")(0)
            i = i + 1
    Next
   
    tEnd = Timer
    Application.ScreenUpdating = True
   
    myMsg = "Veriler " & Format(tEnd - tStart, "0.00") & " saniyede alınmıştır..."
           
    MsgBox myMsg, vbInformation, "Bilgi..."
   
    Set objHTTP = Nothing

End Sub

Ayrıca Enpara arka plan kısmı bu şekilde burası kullanılarak çekilebilir mi?

Haluk · 2 Nisan 2023

C#:

Sub Test2()
'   Haluk - 02/04/2023

    Dim HTTP As Object, HTML As Object, i As Integer, j As Integer
    Dim myURL As String
    
    Range("A1:C" & Rows.Count) = ""
    Range("B1:C1") = Array("ALIŞ", "SATIŞ")
    
    Set HTML = CreateObject("HTMLFILE")
    Set HTTP = CreateObject("MSXML2.XMLHTTP")
    
    myURL = "https://www.qnbfinansbank.enpara.com/hesaplar/doviz-ve-altin-kurlari"
    
    HTTP.Open "GET", myURL, False
    HTTP.send
    
    HTML.body.innerHTML = HTTP.responseText
    Set objCollection = HTML.getElementsByTagName("div")
    
    j = 1
    
    For i = 0 To objCollection.Length - 1
        If objCollection(i).ClassName = "enpara-gold-exchange-rates__table-item USD" Or _
            objCollection(i).ClassName = "enpara-gold-exchange-rates__table-item EUR" Or _
            objCollection(i).ClassName = "enpara-gold-exchange-rates__table-item XAU" Then
            
            j = j + 1
            
            Range("A" & j) = objCollection(i).getElementsByTagName("span")(0).innerText
            Range("B" & j) = Replace(objCollection(i).getElementsByTagName("span")(1).innerText, " TL", "") + 0
            Range("C" & j) = Replace(objCollection(i).getElementsByTagName("span")(2).innerText, " TL", "") + 0
        End If
    Next
    
    Set HTML = Nothing
    Set HTTP = Nothing
End Sub

.

KoNFiCuS · 3 Nisan 2023

Haluk' Alıntı:

C#:

Sub Test2()
'   Haluk - 02/04/2023

    Dim HTTP As Object, HTML As Object, i As Integer, j As Integer
    Dim myURL As String
   
    Range("A1:C" & Rows.Count) = ""
    Range("B1:C1") = Array("ALIŞ", "SATIŞ")
   
    Set HTML = CreateObject("HTMLFILE")
    Set HTTP = CreateObject("MSXML2.XMLHTTP")
   
    myURL = "https://www.qnbfinansbank.enpara.com/hesaplar/doviz-ve-altin-kurlari"
   
    HTTP.Open "GET", myURL, False
    HTTP.send
   
    HTML.body.innerHTML = HTTP.responseText
    Set objCollection = HTML.getElementsByTagName("div")
   
    j = 1
   
    For i = 0 To objCollection.Length - 1
        If objCollection(i).ClassName = "enpara-gold-exchange-rates__table-item USD" Or _
            objCollection(i).ClassName = "enpara-gold-exchange-rates__table-item EUR" Or _
            objCollection(i).ClassName = "enpara-gold-exchange-rates__table-item XAU" Then
           
            j = j + 1
           
            Range("A" & j) = objCollection(i).getElementsByTagName("span")(0).innerText
            Range("B" & j) = Replace(objCollection(i).getElementsByTagName("span")(1).innerText, " TL", "") + 0
            Range("C" & j) = Replace(objCollection(i).getElementsByTagName("span")(2).innerText, " TL", "") + 0
        End If
    Next
   
    Set HTML = Nothing
    Set HTTP = Nothing
End Sub

.

Haluk hocam,

çok teşekkürler tek kelime ile mükemmelsin, naçizane bir sorum daha olacak, akbank içinde aynı şeyi denedim, ama arka planda forex dataları getiriyor gibi. Hiç inceleme fırsatın oldu mu? Akbank içinde benzer bir uygulama yapılabilir mi?

Haluk · 3 Nisan 2023

EnPara ile başladık, Akbank ile devam ediyoruz...... bundan sonra sırada başka bankalar da var herhalde.

Bence siz aşağıdaki kodu deneyin. Serbest Piyasa, Kapalı Çarşı ve Akbank dahil olmak üzere 20 civarında Kamu ve Özel Bankanın anlık $ kurlarını alabilirsiniz...

C#:

Sub Test3()
'   Haluk - 03/04/2023

    Dim objHTTP As Object, strURL As String
    Dim HTML As Object, Tables As Object, Table As Object
    Dim x As Integer, i As Long, iRow As Long, j As Integer

    Range("A1:F" & Rows.Count) = ""

    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "https://canlidoviz.com/doviz-kurlari/dolar"

    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = CreateObject("HTMLFILE")
    HTML.body.innerHTML = objHTTP.responseText

    Set Tables = HTML.getElementsByTagName("table")
  
    Set MyTable = Tables(0)
  
        For i = 0 To MyTable.Rows.Length - 1
            iRow = iRow + 1
            For j = 0 To MyTable.Rows(i).Cells.Length - 1
                temp = MyTable.Rows(i).Cells(j).innerText
                If j = 2 Then
                    Cells(iRow, j + 1) = Split(temp, vbCrLf)(0)
                Else
                    Cells(iRow, j + 1) = MyTable.Rows(i).Cells(j).innerText
                End If
            Next
        Next
End Sub

.

KoNFiCuS · 3 Nisan 2023

Teşekkür ederim, Haluk hocam aslında 2 banka ile çalışıyordum Enpara ve Akbank. Verdiğiniz makro bence birçok kişinin işine yarayacaktır.
Yardımlarınız için tekrar teşekkür ederim.

Haluk · 3 Nisan 2023

Kolay gelsin, altın fiyatları için de kodda aşağıdaki URL'i kullanırsınız....

C#:

    strURL = "https://canlidoviz.com/altin-fiyatlari"

.

KoNFiCuS · 3 Nisan 2023

Haluk' Alıntı:

EnPara ile başladık, Akbank ile devam ediyoruz...... bundan sonra sırada başka bankalar da var herhalde.

Bence siz aşağıdaki kodu deneyin. Serbest Piyasa, Kapalı Çarşı ve Akbank dahil olmak üzere 20 civarında Kamu ve Özel Bankanın anlık $ kurlarını alabilirsiniz...

C#:

Sub Test3()
'   Haluk - 03/04/2023

    Dim objHTTP As Object, strURL As String
    Dim HTML As Object, Tables As Object, Table As Object
    Dim x As Integer, i As Long, iRow As Long, j As Integer

    Range("A1:F" & Rows.Count) = ""

    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "https://canlidoviz.com/doviz-kurlari/dolar"

    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = CreateObject("HTMLFILE")
    HTML.body.innerHTML = objHTTP.responseText

    Set Tables = HTML.getElementsByTagName("table")
 
    Set MyTable = Tables(0)
 
        For i = 0 To MyTable.Rows.Length - 1
            iRow = iRow + 1
            For j = 0 To MyTable.Rows(i).Cells.Length - 1
                temp = MyTable.Rows(i).Cells(j).innerText
                If j = 2 Then
                    Cells(iRow, j + 1) = Split(temp, vbCrLf)(0)
                Else
                    Cells(iRow, j + 1) = MyTable.Rows(i).Cells(j).innerText
                End If
            Next
        Next
End Sub

.

Haluk hocam, bu son verdiğinde link değiştirdiğimizde mesela;

Kod:

    'strURL = "https://canlidoviz.com/doviz-kurlari/dolar"
    'strURL = "https://canlidoviz.com/altin-fiyatlari"
    strURL = "https://canlidoviz.com/altin-fiyatlari/gram-altin"

istediğimiz birimin detaylarını görebiliyoruz dediğiniz gibi banka ve piyasalar dahil, bir sorum olacak buradan gelen tüm bilgilerde mesela Gram Altın kısmında son çıktıda sadece Serbest Piyasa, Akbank ve Enpara detaylarını getiri nasıl yapabiliriz?
Yani tüm listeyi değil sadece belirli istediklerimizi getirsin.

Çok teşekkür ederim.

Haluk · 3 Nisan 2023

Döviz için;

C#:

Sub Test4()
'   Haluk - 03/04/2023

    Dim objHTTP As Object, strURL As String
    Dim HTML As Object, Tables As Object, Table As Object
    Dim x As Integer, i As Long, iRow As Long, j As Integer

    Range("A1:F" & Rows.Count) = ""

    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "https://canlidoviz.com/doviz-kurlari/dolar"

    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = CreateObject("HTMLFILE")
    HTML.body.innerHTML = objHTTP.responseText

    Set Tables = HTML.getElementsByTagName("table")

    Set MyTable = Tables(0)
  
    Range("B1:F1") = Array("ALIŞ", "SATIŞ", "EN YÜKSEK", "EN DÜŞÜK", "KAPANIŞ")

    iRow = 1
  
    For i = 1 To MyTable.Rows.Length - 1
        temp = MyTable.Rows(i).Cells(0).innerText
        If InStr(1, temp, "Serbest Piyasa") > 0 Or _
            InStr(1, temp, "Akbank") > 0 Or _
            InStr(1, temp, "Enpara") > 0 Then
          
            iRow = iRow + 1
          
            For j = 0 To MyTable.Rows(i).Cells.Length - 1
                temp = MyTable.Rows(i).Cells(j).innerText
                If j = 2 Then
                    Cells(iRow, j + 1) = Split(temp, vbCrLf)(0)
                Else
                    Cells(iRow, j + 1) = MyTable.Rows(i).Cells(j).innerText
                End If
            Next
        End If
    Next
End Sub

Gram Altın için;

C#:

    strURL = "https://canlidoviz.com/altin-fiyatlari/gram-altin"

.

KoNFiCuS · 3 Nisan 2023

Haluk' Alıntı:

Döviz için;

C#:

Sub Test4()
'   Haluk - 03/04/2023

    Dim objHTTP As Object, strURL As String
    Dim HTML As Object, Tables As Object, Table As Object
    Dim x As Integer, i As Long, iRow As Long, j As Integer

    Range("A1:F" & Rows.Count) = ""

    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "https://canlidoviz.com/doviz-kurlari/dolar"

    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = CreateObject("HTMLFILE")
    HTML.body.innerHTML = objHTTP.responseText

    Set Tables = HTML.getElementsByTagName("table")

    Set MyTable = Tables(0)
 
    Range("B1:F1") = Array("ALIŞ", "SATIŞ", "EN YÜKSEK", "EN DÜŞÜK", "KAPANIŞ")

    iRow = 1
 
    For i = 1 To MyTable.Rows.Length - 1
        temp = MyTable.Rows(i).Cells(0).innerText
        If InStr(1, temp, "Serbest Piyasa") > 0 Or _
            InStr(1, temp, "Akbank") > 0 Or _
            InStr(1, temp, "Enpara") > 0 Then
         
            iRow = iRow + 1
         
            For j = 0 To MyTable.Rows(i).Cells.Length - 1
                temp = MyTable.Rows(i).Cells(j).innerText
                If j = 2 Then
                    Cells(iRow, j + 1) = Split(temp, vbCrLf)(0)
                Else
                    Cells(iRow, j + 1) = MyTable.Rows(i).Cells(j).innerText
                End If
            Next
        End If
    Next
End Sub

Gram Altın için;

C#:

    strURL = "https://canlidoviz.com/altin-fiyatlari/gram-altin"

.

Çok teşekkür ederim, Haluk hocam, sayenizde daha detaylı inceleyip, kendim de başka uygulamalarını yapmaya çalışacağım.

İyi günler dilerim.

assenucler · 3 Nisan 2023

Sayın KoNFiCuS,

Bizlere de yararlı olacağını düşündüğüm dosyanızı paylaşmanız mümkün mü?

Haluk üstadımızın katkıları için de teşekkürler. Allah razı olsun.

Saygılar,

Selim

Haluk · 4 Nisan 2023

@assenucler ;

Yukarıdaki mesajlarda yer alan kodların tümü ekli dosyada yer almaktadır.

.

KoNFiCuS · 4 Nisan 2023

Haluk' Alıntı:
@assenucler ;

Yukarıdaki mesajlarda yer alan kodların tümü ekli dosyada yer almaktadır.

.

Bu vesile ile @Haluk Hocama tekrar teşekkür ederim.

@assenucler hocam paylaşmış.

assenucler · 4 Nisan 2023

Sayın Haluk,

Değerli üstadım paylaşımınız için teşekkürler.
Allah'ım sizden razı olsun.

Hayırlı Ramazanlar diliyor, selam ve saygılarımı yolluyorum.

Çözüldü EnPara Güncel Kur ve Altın bilgileri otomatik alma.

KoNFiCuS

Haluk

𐱅𐰇𐰼𐰚

KoNFiCuS

Haluk

𐱅𐰇𐰼𐰚

KoNFiCuS

Haluk

𐱅𐰇𐰼𐰚

KoNFiCuS

Haluk

𐱅𐰇𐰼𐰚

KoNFiCuS

assenucler

Haluk

𐱅𐰇𐰼𐰚

Ekli dosyalar

KoNFiCuS

assenucler