• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Çözüldü Güncel altın fiyatları

  • Konbuyu başlatan Konbuyu başlatan k0081
  • Başlangıç tarihi Başlangıç tarihi
Katılım
17 Haziran 2008
Mesajlar
1,874
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Merhaba arkadaşlar;

https://altin.in/

Bu sitedeki güncel altın alış fiyatlarını ve eski tarihli fiyatları ( tarih girerek )

Mesaj kutusunda nasıl alabiliriz ?

Bir kaç deneme yaptım. Fakat sağlıklı sonuç alamadım.


Yardımcı arkadaşa şimdiden Teşekkür ederim.
 
Merhaba
Gram altın içinse aşağıdaki kodları deneyin,
"tr" tanımını siz ayarlarsınız
Kod:
tr = Date 
yıl = Year(tr)
ay = Format(tr, "mm")
gun = Format(tr, "dd")
Set ie = CreateObject("internetexplorer.application")
ie.Visible = False: ie.Navigate "https://altin.in/arsiv/" & yıl & "/" & ay & "/" & gun
Do While ie.Busy And Not ie.ReadyState = READYSTATE_COMPLETE
DoEvents: Loop:
Application.Wait (Now + TimeValue("0:00:03"))
For Each j In ie.document.getElementById("icerik").getElementsByClassName("kurlar bordernone")
If j.getElementsByTagName("li")(0).innertext = "Gram Altın Fiyatları" Then
MsgBox "Gram Altın Alış  : " & j.getElementsByTagName("li")(1).innertext & vbCrLf & "Gram Altın Satış : " & j.getElementsByTagName("li")(2).innertext
exit for
end if
Next
ie.Quit
 
Son düzenleme:
Merhaba Sayın Plint,
Tarih değişse de gelen rakamlar değişmiyor. Neden olabilir?
Saygılarımla
 
PLİNT;

Hocam kod için teşekkürler.

Set ie = CreateObject("internetexplorer.application")

yerine;

Set obj = CreateObject("MSXML2.XMLHTTP") kullansak kodları nasıl değiştirmeliyiz ?

kurlar bordernone, li, icerik Bu değişkenleri nasıl tayin ettiniz ?
 
Son düzenleme:
PLİNT;

Set obj = CreateObject("MSXML2.XMLHTTP") kullansak kodları nasıl değiştirmeliyiz ?
Merhaba
Aşağıdaki gibi deneyin

Kod:
Dim a As Object: Set a = CreateObject("htmlFile")
Dim x As Object, tr As Date, yıl As String, ay As String, gun As String
tr = Date
yıl = Year(tr)
ay = Format(tr, "mm")
gun = Format(tr, "dd")
Set x = CreateObject("MSXML2.XMLHTTP")
x.Open "Get", "https://altin.in/arsiv/" & yıl & "/" & ay & "/" & gun & """, False"
x.send
Application.Wait (Now + TimeValue("0:00:05")) 'internet hızına göre
a.body.innerHTML = x.responseText
Set c = a.getElementById("icerik")
On Error Resume Next
'msgbox c.innertext 'incelemesi ile aşağıdaki
MsgBox c.Children(0).Children(4).Children(10).innertext
x.Close
Set x = Nothing

PLİNT;
kurlar bordernone, li, icerik Bu değişkenleri nasıl tayin ettiniz ?
Kodlarla "id", "classname" değişkenlerini öğrenme imkanı var ama "firefox" ta "öğeyi incele" ile buluyorum
"ie" de Araçlar/F12 Geliştirici arçaları ile bulunabilir.
 
Merhaba
Aşağıdaki gibi deneyin

Kod:
Dim a As Object: Set a = CreateObject("htmlFile")
Dim x As Object, tr As Date, yıl As String, ay As String, gun As String
tr = Date
yıl = Year(tr)
ay = Format(tr, "mm")
gun = Format(tr, "dd")
Set x = CreateObject("MSXML2.XMLHTTP")
x.Open "Get", "https://altin.in/arsiv/" & yıl & "/" & ay & "/" & gun & """, False"
x.send
Application.Wait (Now + TimeValue("0:00:05")) 'internet hızına göre
a.body.innerHTML = x.responseText
Set c = a.getElementById("icerik")
On Error Resume Next
'msgbox c.innertext 'incelemesi ile aşağıdaki
MsgBox c.Children(0).Children(4).Children(10).innertext
x.Close
Set x = Nothing


Kodlarla "id", "classname" değişkenlerini öğrenme imkanı var ama "firefox" ta "öğeyi incele" ile buluyorum
"ie" de Araçlar/F12 Geliştirici arçaları ile bulunabilir.


Hocam çok teşekkür ederim. Kahvedeyim de, eve geçince kodları test edeceğim..
 
Plint ;


Hocam çok teşekkür ederim. elinize sağlık. Tamamdır..

"id", "classname" her web sitesinde sabitmidir ?
 
Merhaba
Gram altın içinse aşağıdaki kodları deneyin,
"tr" tanımını siz ayarlarsınız
Kod:
tr = Date
yıl = Year(tr)
ay = Format(tr, "mm")
gun = Format(tr, "dd")
Set ie = CreateObject("internetexplorer.application")
ie.Visible = False: ie.Navigate "https://altin.in/arsiv/" & yıl & "/" & ay & "/" & gun
Do While ie.Busy And Not ie.ReadyState = READYSTATE_COMPLETE
DoEvents: Loop:
Application.Wait (Now + TimeValue("0:00:03"))
For Each j In ie.document.getElementById("icerik").getElementsByClassName("kurlar bordernone")
If j.getElementsByTagName("li")(0).innertext = "Gram Altın Fiyatları" Then
MsgBox "Gram Altın Alış  : " & j.getElementsByTagName("li")(1).innertext & vbCrLf & "Gram Altın Satış : " & j.getElementsByTagName("li")(2).innertext
exit for
end if
Next
ie.Quit
Üstad kod paylaşımı için teşekkürler
 
Merhaba
Gram altın içinse aşağıdaki kodları deneyin,
"tr" tanımını siz ayarlarsınız
Kod:
tr = Date
yıl = Year(tr)
ay = Format(tr, "mm")
gun = Format(tr, "dd")
Set ie = CreateObject("internetexplorer.application")
ie.Visible = False: ie.Navigate "https://altin.in/arsiv/" & yıl & "/" & ay & "/" & gun
Do While ie.Busy And Not ie.ReadyState = READYSTATE_COMPLETE
DoEvents: Loop:
Application.Wait (Now + TimeValue("0:00:03"))
For Each j In ie.document.getElementById("icerik").getElementsByClassName("kurlar bordernone")
If j.getElementsByTagName("li")(0).innertext = "Gram Altın Fiyatları" Then
MsgBox "Gram Altın Alış  : " & j.getElementsByTagName("li")(1).innertext & vbCrLf & "Gram Altın Satış : " & j.getElementsByTagName("li")(2).innertext
exit for
end if
Next
ie.Quit

Hocam merhaba,

Öncelikle elinize sağlık.
Bu tabloyu mesajda çıkartmak yerine, x bir sheette A1'e yazdırmak istersek ne yapmamız gerekiyor?
 
Merhaba,
tr = [A1].value
yazın yeter
iyi çalışmalar
 
Kod:
'Alış fiyatı için
Worksheets(x).[A1]= j.getElementsByTagName("li")(1).innertext
'Satış fiyatı için
Worksheets(x).[A2]= j.getElementsByTagName("li")(2).innertext
'x olan yere sayfa isminizi girersiniz.
 
Hocalar merhaba tekrardan,

Öncelikle hızlı desteğiniz için teşekkürler.
Makro ile çok içli dışlı değilim, belirtilen kodu nereye eklemem gerekiyor?

Kod:
Sub ALTIN_CEK()

tr = Date

yıl = Year(tr)

ay = Format(tr, "mm")

gun = Format(tr, "dd")

Set ie = CreateObject("internetexplorer.application")

ie.Visible = False: ie.Navigate "https://altin.in/arsiv/" & yıl & "/" & ay & "/" & gun

Do While ie.Busy And Not ie.ReadyState = READYSTATE_COMPLETE

DoEvents: Loop:

For Each j In ie.document.getElementById("icerik").getElementsByClassName("kurlar bordernone")

If j.getElementsByTagName("li")(0).innertext = "Gram Altın Fiyatları" Then

MsgBox "Gram Altın Alış  : " & j.getElementsByTagName("li")(1).innertext & vbCrLf & "Gram Altın Satış : " & j.getElementsByTagName("li")(2).innertext

Exit For

End If

Next

ie.Quit

End Sub
 
Bu tabloyu mesajda çıkartmak yerine, x bir sheette A1'e yazdırmak istersek ne yapmamız gerekiyor?
MsgBox "Gram Altın Alış : " & j.getElementsByTagName("li")(1).innertext & vbCrLf & "Gram Altın Satış : " & j.getElementsByTagName("li")(2).innertext
Bu satırın yerine yazabilirsiniz.
 
Sayfa ismini tırnak içinde yazın ..... "Altın"

.
 
Geri
Üst