• DİKKAT

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

Döviz kuru sayfasından veri çekme problemi

Bu kadar büyük puntalarla başlık atmaya gerek varmı
Kodu yazdım ama bu büyük puntalarla yazmış olduğunuz sorunuzu düzeltilseniz ekliyeceğim.
 
kod:

Kod: 
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Sub veri()
Dim URL As String

Dim ie As Object

Range("A1:ı5000").ClearContents

URL = "http://www.albarakaturk.com.tr/doviz-kurlari.aspx"
Set ie = CreateObject("InternetExplorer.Application")
sat = 1
Cells(1, 1) = "DÖVİZ KURLARI"


With ie
.Navigate URL
.Visible = 1
ShowWindow ie.hwnd, 6
Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop

On Error Resume Next

Set t = ie.Document.getElementsByTagName("table").Item(0)
For i = 0 To t.Rows.Length - 1
For j = 0 To t.Cells.Length - 1

If i Mod 2 = 1 Then
Cells(sat, j + 1) = t.Rows(i).Cells(j).innerText
Else
Cells(sat, j + 2) = t.Rows(i).Cells(j).innerText
End If

Next
sat = sat + 1
Next
Cells(1, 2) = ""

ie.Quit: Set ie = Nothing
End With


MsgBox ("Bitti  ")
End Sub
 
Bu şekilde bir hata alıyorum.
"Compile error:
The code in this project must be updaded for use on 64-bit systems. Please review and update Declare statements and mark them with the PtrSafe attribute."
 
Birde bunu dene

Kod: 
#If Win64 Then
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
#Else
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
#End If
#If VBA7 Then
#Else
#End If


Sub veri()
Dim URL As String

Dim ie As Object

Range("A1:ı5000").ClearContents

URL = "http://www.albarakaturk.com.tr/doviz-kurlari.aspx"
Set ie = CreateObject("InternetExplorer.Application")
sat = 1
Cells(1, 1) = "DÖVİZ KURLARI"


With ie
.Navigate URL
.Visible = 1
ShowWindow ie.hwnd, 6
Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop

On Error Resume Next

Set t = ie.Document.getElementsByTagName("table").Item(0)
For i = 0 To t.Rows.Length - 1
For j = 0 To t.Cells.Length - 1

If i Mod 2 = 1 Then
Cells(sat, j + 1) = t.Rows(i).Cells(j).innerText
Else
Cells(sat, j + 2) = t.Rows(i).Cells(j).innerText
End If

Next
sat = sat + 1
Next
Cells(1, 2) = ""

ie.Quit: Set ie = Nothing
End With


MsgBox ("Bitti  ")
End Sub
 
Kuveyttürk Döviz Kuru Çekme, Otomatik Güncelleme ve Arşiv

Merhaba Üstadım,

Yaklaşık 2 haftadır benzer bir problemle uğraşıyorum. Kuveyttürk sitesinden otomatik olarak döviz kurlarını almak istiyorum. Ama Excel'de Veri Sekmesinden Webden bölümünden ilgili siteye gidip, döviz kurlarını al dediğimde Ekte de gönderdiğim resimde göreceğiniz üzere "internet sunucusu ya da proxy sunucusu konumlandırılamıyor" hatası alıyorum. Aynı işlemi başka bir site için yaptığımda (örneğin bigpara.com) herhangi bir problem olmadan verileri alabiliyorum ve 1 dakikada bir güncelleyebiliyorum. Kendim çözebilmek için çok uğraştım ama bir türlü başaramadım. Öncelikle bu sitede böyle bir hata almamın sebebini açıklayabilirseniz çok memnun olurum.

Sonra burada yazdığınız kodu gördüm. Denedim, çalıştı. Dosyayı ekte de görebilirsiniz. Yalnız bu dosyada güncelleme olabilmesi için kodu her seferinde kodu çalıştırmam gerekiyor. Ben bu işlemi excelin kendisinin yapmasını ve atıyorum 5 dakikada bir aldığı verileri ARŞİV adlı sayfaya kaydetmesini istiyorum. Bunu yapabilirseniz size çok müteşekkir olurum.
 

Ekli dosyalar

genius1288' Alıntı:
Merhaba Üstadım,

Yaklaşık 2 haftadır benzer bir problemle uğraşıyorum. Kuveyttürk sitesinden otomatik olarak döviz kurlarını almak istiyorum. Ama Excel'de Veri Sekmesinden Webden bölümünden ilgili siteye gidip, döviz kurlarını al dediğimde Ekte de gönderdiğim resimde göreceğiniz üzere "internet sunucusu ya da proxy sunucusu konumlandırılamıyor" hatası alıyorum. Aynı işlemi başka bir site için yaptığımda (örneğin bigpara.com) herhangi bir problem olmadan verileri alabiliyorum ve 1 dakikada bir güncelleyebiliyorum. Kendim çözebilmek için çok uğraştım ama bir türlü başaramadım. Öncelikle bu sitede böyle bir hata almamın sebebini açıklayabilirseniz çok memnun olurum.

Sonra burada yazdığınız kodu gördüm. Denedim, çalıştı. Dosyayı ekte de görebilirsiniz. Yalnız bu dosyada güncelleme olabilmesi için kodu her seferinde kodu çalıştırmam gerekiyor. Ben bu işlemi excelin kendisinin yapmasını ve atıyorum 5 dakikada bir aldığı verileri ARŞİV adlı sayfaya kaydetmesini istiyorum. Bunu yapabilirseniz size çok müteşekkir olurum.
Genişletmek için tıkla ...

Arşiv sayfasındaki komut düğmesine tıklayın ve açılan liste kutusundan zamanı seçin ve çalıştırı tıklayın


not =kodların çalışması için aşağıdaki linkdeki işlemleri yapmak gerekiyor.

görsel video


http://www.excel.web.tr/f167/timer-nesnesinin-kurulumu-t78713.html
 

Ekli dosyalar

iptal edildi kodlar
 
genius1288' Alıntı:
Merhaba Üstadım,

Yaklaşık 2 haftadır benzer bir problemle uğraşıyorum. Kuveyttürk sitesinden otomatik olarak döviz kurlarını almak istiyorum. Ama Excel'de Veri Sekmesinden Webden bölümünden ilgili siteye gidip, döviz kurlarını al dediğimde Ekte de gönderdiğim resimde göreceğiniz üzere "internet sunucusu ya da proxy sunucusu konumlandırılamıyor" hatası alıyorum. Aynı işlemi başka bir site için yaptığımda (örneğin bigpara.com) herhangi bir problem olmadan verileri alabiliyorum ve 1 dakikada bir güncelleyebiliyorum. Kendim çözebilmek için çok uğraştım ama bir türlü başaramadım. Öncelikle bu sitede böyle bir hata almamın sebebini açıklayabilirseniz çok memnun olurum.

Sonra burada yazdığınız kodu gördüm. Denedim, çalıştı. Dosyayı ekte de görebilirsiniz. Yalnız bu dosyada güncelleme olabilmesi için kodu her seferinde kodu çalıştırmam gerekiyor. Ben bu işlemi excelin kendisinin yapmasını ve atıyorum 5 dakikada bir aldığı verileri ARŞİV adlı sayfaya kaydetmesini istiyorum. Bunu yapabilirseniz size çok müteşekkir olurum.
Genişletmek için tıkla ...

Bu dosyadaki kodlarda farklı ARŞİV sayfasında M1 hücresine hangi aralıkta veri alacaksanız o dakikayı yazın ve çalıştır düğmesine tıklayın.


Koddaki hatalar düzeltildi

kod:

Kod: 
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Dim NextTick As Date

Sub calistir()
veri_al2
zaman = CDate(Sheets("ARŞİV").Cells(1, "m").Value)
NextTick = Now + TimeValue(zaman)
Application.OnTime NextTick, "calistir", schedule:=True
End Sub

Sub Durdur()
'On Error Resume Next
Application.OnTime Earliesttime:=NextTick, procedure:="calistir", schedule:=False
End Sub
Sub veri_al2()

Dim URL As String

Dim ie As Object

URL = "http://finans.kuveytturk.com.tr/"
Set ie = CreateObject("InternetExplorer.Application")
'sat = 2
With ie
.Navigate URL
.Visible = 1
ShowWindow ie.hwnd, 6
Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop
On Error Resume Next

Set t = ie.document.getElementsByTagName("table").Item(0)

son = Worksheets("ARŞİV").Cells(Rows.Count, "b").End(3).Row + 1

Sheets("ARŞİV").Cells(son, "a").Value = Format(Now, "hh.mm.ss")

Sheets("ARŞİV").Cells(son, "b").Value = t.Rows(1).Cells(2).innerText
Sheets("ARŞİV").Cells(son, "c").Value = t.Rows(1).Cells(4).innerText
Sheets("ARŞİV").Cells(son, "d").Value = t.Rows(2).Cells(2).innerText
Sheets("ARŞİV").Cells(son, "e").Value = t.Rows(2).Cells(4).innerText
Sheets("ARŞİV").Cells(son, "f").Value = t.Rows(16).Cells(2).innerText
Sheets("ARŞİV").Cells(son, "g").Value = t.Rows(16).Cells(4).innerText

ie.Quit: Set ie = Nothing
End With

End Sub
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst