tcmb.gov.tr'den dövizleri çekmek

tcmb.gov.tr'den dövizleri çekmek

#2079 İleti | mehmethanifi | 16 May 2017, 16:15

Merhabalar,

tcmb.gov.tr'den döviz kurlarını çekmek istiyoruz. Bunun ile ilgili aşağıdaki linkte güzel bir örnek bulduk.
http://wiki.libreoffice.org.tr/Nas%C4%B ... 4%B1_Almak

Yanlız macro kodlarını tarif edilen yere yapıştırıp çalıştırdığım zaman hata aldım.
"Basic, Standard.Module1.DOVIZKURUNUAL betiği çalıştırılırken, betik dili çatı hatası oluştu.

Mesaj: wrong number of parameters!"

ilgili kodu yapıştırdığım metin alanı şu şekilde.

REM ***** BASIC *****


Function DOVIZKURUNUAL( Tarih As Date, ByVal HedefBirim As String, Kur As Byte, AnaPara As Double ) As Double

On Error Goto Hata

Dim BankaWebAdresi
Dim Dosya
Dim Satir As String
Dim Sonuc As Double
Dim BaslangicTarihi As Date
Dim BitisTarihi As Date

HedefBirim = UCase(HedefBirim)

BaslangicTarihi = "16/04/1996"
BitisTarihi = Date

If (Tarih < BaslangicTarihi) Then
Beep
MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru ; ParaMiktarı )" & Chr(10) & Chr(13) & +_
"16/04/1996 Tarihinden önceki T.C. Merkez Bankası döviz kurları" & Chr(10) & +_
"web sitesine girilmemiştir. Lütfen uygun bir tarih giriniz."
Goto Hata
End If

If (Tarih > BitisTarihi) Then
Beep
MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru ; ParaMiktarı )" & Chr(10) & Chr(13) & +_
"Girilen Tarih için günlük kur kaydı bulunamadı. Lütfen uygun bir tarih giriniz."
Goto Hata
End If

If ((HedefBirim <> "USD") And (HedefBirim <> "AUD") And (HedefBirim <> "DKK") And +_
(HedefBirim <> "EUR") And (HedefBirim <> "GBP") And (HedefBirim <> "CHF") And +_
(HedefBirim <> "SEK") And (HedefBirim <> "CAD") And (HedefBirim <> "KWD") And +_
(HedefBirim <> "NOK") And (HedefBirim <> "SAR") And (HedefBirim <> "JPY") And +_
(HedefBirim <> "BGL") And (HedefBirim <> "SYP") And (HedefBirim <> "JOD") And +_
(HedefBirim <> "ILS") And (HedefBirim <> "RON") And (HedefBirim <> "IRR")) Then
Beep
MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru ; ParaMiktarı )" & Chr(10) & Chr(13) & +_
"Hedef Para Birimi Tanınmıyor ve/veya" & Chr(10) & +_
"T.C. Merkez Bankasında işlem görmüyor." & Chr(10) & +_
"Girilebilecek Para Birimleri aşağıda listelenmiştir." & Chr(10) & +_
"USD, AUD, DKK, EUR, GBP, CHF, SEK, CAD, KWD," & Chr(10) & +_
"NOK, SAR, JPY, BGL, SYP, JOD, ILS, RON, IRR"
Goto Hata
End If

If ((Kur < 1) Or (Kur > 4)) Then
Beep
MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru ; ParaMiktarı )" & Chr(10) & Chr(13) & +_
"Dönüşüm için gerekli olan KUR TÜRÜ bilgisi tanımsız." & Chr(10) & +_
"1:Döviz Alış, 2:Döviz Satış, 3:Efektif Alış, 4:Efektif Satış" & Chr(10) & +_
"Lütfen KUR TÜRÜ parametresini doğru giriniz."
Goto Hata
End If

BankaWebAdresi = "http://www.tcmb.gov.tr/kurlar/" & Year(Tarih) & Format(Month(Tarih),"0#") & "/" & Format(Day(Tarih),"0#") & Format(Month(Tarih),"0#") & Year(Tarih) & ".html"

Dosya = FreeFile()
Open BankaWebAdresi For Input As Dosya

While Not Eof(Dosya)
Line Input #Dosya, Satir
If Left(Satir,3) = HedefBirim Then
If (Tarih < CDate("28/01/2002")) Then
Sonuc = AnaPara / Val(Mid(Satir, 17 + Kur * 10, 10))
ElseIf (Tarih >= CDate("28/01/2002")) Then
Sonuc = AnaPara / Val(Mid(Satir, 17 + Kur * 16, 16))
EndIf
Close #Dosya
DOVIZKURUNUAL() = Sonuc
Exit Function
EndIf
Wend

Close #Dosya

Hata:

DOVIZKURUNUAL() = 0.0

End Function

Teşekkürler.
mehmethanifi
 
İleti: 43
Kayıt: 08 May 2013, 12:08
İşletim Sisteminiz: win7
LibreOffice Sürümü: 4.0.2

Re: tcmb.gov.tr'den dövizleri çekmek

#2080 İleti | Hamurcu | 16 May 2017, 16:30

Merhaba,

İlgili kodu ben yazmıştım zamanında ama sonradan TCMB'nin web sayfası yenilendi ve tüm ayarlar değişti.

Kodu tekrar ele almam lazım bu hali ile doğru çalışmaz.

Basic bilen arkadaşlar varsa kodu geliştirebilirler aksi helde ben ilk fırsat bulduğumda kodu yenileyeceğim.
Kullanıcı avatarı
Hamurcu
 
İleti: 88
Kayıt: 06 Ağu 2012, 00:14
Konum: İstanbul
İşletim Sisteminiz: Windows 10
LibreOffice Sürümü: 5.x

Re: tcmb.gov.tr'den dövizleri çekmek

#2081 İleti | mehmethanifi | 16 May 2017, 17:00

Çok teşekkür ederim.
mehmethanifi
 
İleti: 43
Kayıt: 08 May 2013, 12:08
İşletim Sisteminiz: win7
LibreOffice Sürümü: 4.0.2

Re: tcmb.gov.tr'den dövizleri çekmek

#2096 İleti | Hamurcu | 23 May 2017, 14:37

Merhaba,

Bir fırsat bulup T.C. Merkez Bankasının yeni web sayfasına göre ilgili kodu güncelledim.

Öncelikle sizlerden ricam deneyip varsa eksik/hata bildirmeniz.

Daha sonra son halini verip wiki'de yayınlayacağım.

Kullanım şekli şöyle;
Kod: Tümünü seç
=DOVIZKURUAL(Tarih; DovizCinsi; KurTürü; TLMiktarı)


Tarih : Verilen tarihe ait Döviz Kur'u
DövizCinsi : T.C. Merkez Bankasında işlem gören döviz cinsleridir. Örneğin USD, EUR v.b.
KurTürü : Döviz Alış için 1, Döviz Satış için 2, Efektif Alış için 3, Efektif Satış için 4 girilmelidir.
TLMiktarı : Ana Para olarak girilecek değerdir ve yukarıdaki fonksiyon otomatik olarak ilgili para birimine çevirir.

Güncel kod ise şöyle;
Kod: Tümünü seç
Function DovizKuruAl(Tarih As Date, ParaBirimi As String, KurTuru As Byte, AnaPara As Double) As Double

On Error Goto Hata

Dim oleServisi, XMLOku As Object
Dim XMLDal As String
Dim DovizAlis,DovizSatis, EfektifSatis, EfektifAlis As Double
Dim MerkezBankasi, HedefKurAdi As String
Dim Sonuc As Double
Dim BaslangicTarihi As Date
Dim BitisTarihi As Date
Dim HedefKurNo As Byte
Dim Sayfa As Object

BaslangicTarihi = "16/04/1996"

BitisTarihi = Date

ParaBirimi = UCase(ParaBirimi)

Sonuc=0.0

If (Tarih < BaslangicTarihi) Then
   Beep
   MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru ; AnaParaMiktarı )" & Chr(10) & Chr(13) & +_
         "16/04/1996 Tarihinden önceki T.C. Merkez Bankası döviz kurları" & Chr(10) & +_
         "web sitesine girilmemiştir. Lütfen uygun bir tarih giriniz."
   Goto Hata
End If

If (Tarih > BitisTarihi) Then
   Beep
   MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru ; AnaParaMiktarı )" & Chr(10) & Chr(13) & +_
          "Girilen Tarih için günlük kur kaydı bulunamadı. Lütfen uygun bir tarih giriniz."
   Goto Hata
End If

If ((ParaBirimi <> "USD") And (ParaBirimi <> "AUD") And (ParaBirimi <> "DKK") And +_
   (ParaBirimi <> "EUR") And (ParaBirimi <> "GBP") And (ParaBirimi <> "CHF") And +_
   (ParaBirimi <> "SEK") And (ParaBirimi <> "CAD") And (ParaBirimi <> "KWD") And +_
   (ParaBirimi <> "NOK") And (ParaBirimi <> "SAR") And (ParaBirimi <> "JPY") And +_
   (ParaBirimi <> "BGN") And (ParaBirimi <> "PKR") And (ParaBirimi <> "CNY") And +_
   (ParaBirimi <> "RUB") And (ParaBirimi <> "RON") And (ParaBirimi <> "IRR")) Then
   Beep
   MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru ; AnaParaMiktarı )" & Chr(10) & Chr(13) & +_
         "Hedef Para Birimi Tanınmıyor ve/veya" & Chr(10) & +_
         "T.C. Merkez Bankasında işlem görmüyor." & Chr(10) & +_
         "Girilebilecek Para Birimleri aşağıda listelenmiştir." & Chr(10) & +_
         "USD, AUD, DKK, EUR, GBP, CHF, SEK, CAD, KWD," & Chr(10) & +_
         "NOK, SAR, JPY, BGN, RON, RUB, IRR, CNY, PKR"
   Goto Hata
End If

If ((KurTuru < 1) Or (KurTuru > 4)) Then
   Beep
   MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru ; AnaParaMiktarı )" & Chr(10) & Chr(13) & +_
         "Dönüşüm için gerekli olan KUR TÜRÜ bilgisi tanımsız." & Chr(10) & +_
         "1:Döviz Alış, 2:Döviz Satış, 3:Efektif Alış, 4:Efektif Satış" & Chr(10) & +_
         "Lütfen KUR TÜRÜ parametresini doğru giriniz."
   Goto Hata
End If

Select Case ParaBirimi
   Case "USD"
      HedefKurNo=0
      HedefKurAdi="US DOLLAR"
   Case "AUD"
      HedefKurNo=1
      HedefKurAdi="AUSTRALIAN DOLLAR"
   Case "DKK"
      HedefKurNo=2
      HedefKurAdi="DANISH KRONE"
   Case "EUR"
      HedefKurNo=3
      HedefKurAdi="EURO"
   Case "GBP"
      HedefKurNo=4
      HedefKurAdi="POUND STERLING"
   Case "CHF"
      HedefKurNo=5
      HedefKurAdi="SWISS FRANK"
   Case "SEK"
      HedefKurNo=6
      HedefKurAdi="SWEDISH KRONA"
   Case "CAD"
      HedefKurNo=7
      HedefKurAdi="CANADIAN DOLLAR"
   Case "KWD"
      HedefKurNo=8
      HedefKurAdi="KUWAITI DINAR"
   Case "NOK"
      HedefKurNo=9
      HedefKurAdi="NORWEGIAN KRONE"
   Case "SAR"
      HedefKurNo=10
      HedefKurAdi="SAUDI RIYAL"
   Case "JPY"
      HedefKurNo=11
      HedefKurAdi="JAPENESE YEN"
   Case "BGN"
      HedefKurNo=12
      HedefKurAdi="BULGARIAN LEV"
   Case "RON"
      HedefKurNo=13
      HedefKurAdi="NEW LEU"
   Case "RUB"
      HedefKurNo=14
      HedefKurAdi="RUSSIAN ROUBLE"
   Case "IRR"
      HedefKurNo=15
      HedefKurAdi="IRANIAN RIAL"
   Case "CNY"
      HedefKurNo=16
      HedefKurAdi="CHINESE RENMINBI"
   Case "PKR"
      HedefKurNo=17
      HedefKurAdi="PAKISTANI RUPEE"
End Select

oleServisi = createUnoService( "com.sun.star.sheet.FunctionAccess" )

MerkezBankasi = "http://www.tcmb.gov.tr/kurlar/" & Year(Tarih) & Format(Month(Tarih),"0#") & "/" & +_
            Format(Day(Tarih),"0#") & Format(Month(Tarih),"0#") & Year(Tarih) & ".xml"

With oleServisi

   XML_String = .callFunction("WEBSERVICE",array(MerkezBankasi))

   For Birimler=0 To 17
   
      XMLDal= .callFunction("FILTERXML", array(XML_String, "string(/Tarih_Date/Currency["+Birimler+"]/CurrencyName[1])"))
   
      If XMLDal=HedefKurAdi Then
         DovizAlis    = .callFunction("FILTERXML", array(XML_String, "number(/Tarih_Date/Currency["+Birimler+"]/ForexBuying[1])"))
         DovizSatis   = .callFunction("FILTERXML", array(XML_String, "number(/Tarih_Date/Currency["+Birimler+"]/ForexSelling[1])"))
         EfektifAlis  = .callFunction("FILTERXML", array(XML_String, "number(/Tarih_Date/Currency["+Birimler+"]/BanknoteBuying[1])"))
         EfektifSatis = .callFunction("FILTERXML", array(XML_String, "number(/Tarih_Date/Currency["+Birimler+"]/BanknoteSelling[1])"))
      End If

   Next Birimler
   
   Select Case KurTuru
      Case 1
         Sonuc=AnaPara/DovizAlis
         Case 2
            Sonuc=AnaPara/DovizSatis
         Case 3
            Sonuc=AnaPara/EfektifAlis
         Case 4
            Sonuc=AnaPara/EfektifSatis
      End Select
          
   DovizKuruAl() = Sonuc

   Exit Function

End With
   
Hata:

   DovizKuruAl() = 0.0
   
End Function
Kullanıcı avatarı
Hamurcu
 
İleti: 88
Kayıt: 06 Ağu 2012, 00:14
Konum: İstanbul
İşletim Sisteminiz: Windows 10
LibreOffice Sürümü: 5.x


Calc - Hesap Tablosu

Kimler çevrimiçi

Kayıtlı kullanıcılar: Bing [Bot], Hamurcu, Yahoo [Bot]

cron