webden veri çekme

[bymarduk]

merhabalar,
şu konuda webden veri çekerek istediğim bilgileri listeleyebildim.
fakat istediğim şey bunu makro ile yapmak. çok aradım ama hiçbir yerde bununla ilgili tam bir şey yok.
örneğin şu linkteki gram altın fiyatlarını almak istiyorum http://www.qnbfinansbank.enpara.com/doviz-kur-bilgileri/doviz-altin-kurlari.aspx

nasıl yapabilirim yardımcı olur musunuz

 

[bymarduk]

Sub extractdatafromwebsite()
Dim ie As New InternetExplorer
Dim Tickername As String
Dim doc As HTMLDocument
Tickername = Sheet1.Range("A2").Value

ie.Visible = True
ie.navigate "http://www.qnbfinansbank.enpara.com/doviz-kur-bilgileri/doviz-altin-kurlari.aspx"
Do
    DoEvents
    Loop Until ie.ReadyState = READYSTATE_COMPLETE
    

Set doc = ie.Document
On Error Resume Next
output = doc.getElementByTagName("dlCont").innerText
Sheet1.Range("B2").Value = output

ie.Quit


End Sub

bu kod işe yarıyor gibi fakat gram altın fiyatını html olarak hangi etiketle alacağımı bulamadım

 

[Murat OSMA]

Bu kodları kullanabilirsiniz.. ​

[FONT="Trebuchet MS"][SIZE="2"]Sub Emre()
    Set ie = CreateObject("InternetExplorer.Application")
    ie.navigate "http://www.qnbfinansbank.enpara.com/doviz-kur-bilgileri/doviz-altin-kurlari.aspx"
    Do: DoEvents: Loop Until ie.ReadyState = 4
    alis = ie.Document.getElementsByClassName("dlCont")(7).innerText
    satis = ie.Document.getElementsByClassName("dlCont")(8).innerText
    ActiveSheet.Range("A1").Value = alis
    ActiveSheet.Range("A2").Value = satis
    ie.Quit
End Sub[/SIZE][/FONT]

 

[bymarduk]

merhaba,
kodu çalıştıramadım object doesn't support this property or method şeklinde bir hata veriyor
alis = ie.Document.getElementsByClassName("dlCont")(7).innerText satırında hata
excel 2007 kullanıyorum bununla alakalı sanırım
nasıl düzeltebilirim
edit: explorerdan kaynaklanıyor sanırım eski bir sürüm ve güncelleyemiyorum.

 

[isteobenim]

Web'den Dosya Download Yapmak

Bu kodları kullanabilirsiniz.. ​

[FONT="Trebuchet MS"][SIZE="2"]Sub Emre()
    Set ie = CreateObject("InternetExplorer.Application")
    ie.navigate "http://www.qnbfinansbank.enpara.com/doviz-kur-bilgileri/doviz-altin-kurlari.aspx"
    Do: DoEvents: Loop Until ie.ReadyState = 4
    alis = ie.Document.getElementsByClassName("dlCont")(7).innerText
    satis = ie.Document.getElementsByClassName("dlCont")(8).innerText
    ActiveSheet.Range("A1").Value = alis
    ActiveSheet.Range("A2").Value = satis
    ie.Quit
End Sub[/SIZE][/FONT]

Merhaba,

Web'den vba ile dosya indirme butonunu tetikledikten sonra altta çıkan "xxx.tr etki alanından dosyasını açmak yada kaydetmek istiyor musunuz?" uyarı penceresini nasıl iptal edebiliriz, bu alanı İE ayarlarından ne iptal edebiliyorum ne de kaynak kodlarına ulaşabiliyorum, SendKeys kullanmadan direkt kayıt yaptırarak bu alanı nasıl geçebilirim, yardımcı olabilir misiniz.

Örnek Kod;
Sub Website()
Dim Doc As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
navigate:
IE.navigate "http://www.spk.gov.tr/apps/MutualFundsPortfolioValues/FundsInfosFP.aspx?ctype=E&submenuheader=0"
Do While IE.ReadyState <> 4: DoEvents: Loop
'Set Doc = CreateObject("htmlfile")
Set Doc = IE.Document
If Doc Is Nothing Then GoTo navigate
'IE.Activate
Doc.getelementbyid("txtDateBegin").Value = "23.03.2017"
Doc.getelementbyid("txtDateEnd").Value = "24.03.2017"
Doc.getelementbyid("btnCompanyAddAll").Click
Application.wait Now + TimeSerial(0, 0, 5)
Doc.getelementbyid("btnSubmit").Click
Application.wait Now + TimeSerial(0, 0, 3)
Doc.getelementbyid("btnSaveAsXls").Click
'IE.Quit
'Set IE = Nothing
End Sub

 

[askm]

Kodları aşağıdaki şekilde revize edin. Direkt kayır yapacaktır.

Sub Website()
Dim Doc As Object


Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
navigate:
ie.navigate "http://www.spk.gov.tr/apps/MutualFundsPortfolioValues/FundsInfosFP.aspx?ctype=E&submenuheader=0"
Do While ie.ReadyState <> 4: DoEvents: Loop
'Set Doc = CreateObject("htmlfile")
Set Doc = ie.Document
If Doc Is Nothing Then GoTo navigate
'IE.Activate
Doc.getelementbyid("txtDateBegin").Value = "23.03.2017"
Doc.getelementbyid("txtDateEnd").Value = "24.03.2017"
Doc.getelementbyid("btnCompanyAddAll").Click
Application.Wait Now + TimeSerial(0, 0, 5)
Doc.getelementbyid("btnSubmit").Click
Application.Wait Now + TimeSerial(0, 0, 3)
Doc.getelementbyid("btnSaveAsXls").Click
Application.Wait Now + TimeSerial(0, 0, 3)
Application.SendKeys "%k~"

'IE.Quit
'Set IE = Nothing
End Sub

 

[isteobenim]

Sayın askm,

Cevabınız için teşekkür ederim,
Ancak benim SendKeys kullanmadan çözüm bulmam gerekiyor, çünkü SendKeys komutları bilgisayar kilitli konumda iken maalesef çalışmıyor,

 

[isteobenim]

Merhaba,

Konu henüz günceldir, yardımcı olabilecek olan arkadaşlar tekrar ilgilenebilir mi?

Teşekkürler,