Skip to main content

AccessTr.neT


Access Form Kullanmadan Döviz Kuru Alma

Access Form Kullanmadan Döviz Kuru Alma

#13
Kodun kullanımı Hakkında:
İlk defa kodu çalıştırıp, daha sonra istemediğiniz alanları silinmesini yukarıdaki mesajda belirtmiştim. Ayrıca Bu alanların metin olan veri türleri değiştirile biliniyor. Daha sonra eklenen veriler bu veri türü ile kaydediliyor.
Yine tabloya yeni alan eklene bilinir (Mesela Tarih alanı)  ve Bu alanlar verinin Alınışının sonrasında update ile güncellene bilinir.
Cevapla
#14
ne kadar güzel
@benbendedeilem
Cevapla
#15
(06/05/2020, 00:06)berduş yazdı: Dilerim işinize yayar
Orijinal çalışma: https://accesstr.net/konu-web-uzerinden-...rgula.html
tabloya tarih alanı eklendi
Modüle web sayfası var mı kontrol kodu eklendi
Function URLExists(url As String) As Boolean
    Dim Request As Object
    Dim ff As Integer
    Dim rc As Variant

    On Error GoTo EndNow
    Set Request = CreateObject("WinHttp.WinHttpRequest.5.1")

    With Request
      .Open "GET", url, False
      .Send
      rc = .StatusText
    End With
    Set Request = Nothing
    If rc = "OK" Then URLExists = True

    Exit Function
EndNow:
End Function
userformdaki sorgula düğmesinin kodu
Dim Adrs As String
Dim ParaBirim As String
SorguTarihi = CDate(Me.TxtTrh.Value)

Set xmldoc = CreateObject("Msxml.DOMDocument")
    Dim DovizListesi, Dovizler As Object
    xmldoc.async = False


If SorguTarihi <> Date Then

Adrs = "http://www.tcmb.gov.tr/kurlar/" & CStr(Format(SorguTarihi, "yyyymm") & "/" & Format(SorguTarihi, "ddmmyyyy")) & ".xml"
   
Else

Adrs = "http://www.tcmb.gov.tr/kurlar/today.xml"
           
End If
If URLExists(Adrs) = False Then
    MsgBox "bu tarihe ait kayıt yok"
    Exit Sub
End If
xmldoc.Load Adrs
Set DovizListesi = xmldoc.DocumentElement.SelectNodes("Currency")
On Error Resume Next

Set baglan = CreateObject("adodb.connection")
baglan.Open "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.Path & "\Döviz.accdb"

For Each Dovizler In DovizListesi
        If Len(Dovizler.SelectSingleNode("BanknoteBuying").Text & "") = 0 Or Len(Dovizler.SelectSingleNode("BanknoteSelling").Text & "") = 0 Then
        Exit For
        End If
ParaBirim = Dovizler.SelectSingleNode("CurrencyName").Text

Select Case ParaBirim

  Case "US DOLLAR"
      txtDövizAdi = "USD"
  Case "AUSTRALIAN DOLLAR"
      txtDövizAdi = "AUD"
  Case "DANISH KRONE"
      txtDövizAdi = "DKK"
  Case "EURO"
      txtDövizAdi = "EUR"
  Case "POUND STERLING"
      txtDövizAdi = "GBP"
  Case "SWISS FRANK"
      txtDövizAdi = "CHF"
  Case "SWEDISH KRONA"
      txtDövizAdi = "SEK"
  Case "CANADIAN DOLLAR"
      txtDövizAdi = "CAD"
  Case "KUWAITI DINAR"
      txtDövizAdi = "KWD"
  Case "NORWEGIAN KRONE"
      txtDövizAdi = "NOK"
  Case "SAUDI RIYAL"
      txtDövizAdi = "SAR"
  Case "JAPENESE YEN"
      txtDövizAdi = "JPY"

End Select

SqlEkle = " INSERT INTO [Döviz] ([VeriTrh], DövizCinsi, DövizAdi, [DövizAlis], [DövizSatis],[EfektifAlis],[EfektifSatis]) " & _
          " VALUES (" & CLng(SorguTarihi) & ",'" & txtDövizAdi & "','" & _
            Dovizler.SelectSingleNode("Isim").Text & "',CCur('" & _
            Replace(Dovizler.SelectSingleNode("ForexBuying").Text, ".", ",") & "'), CCur('" & _
            Replace(Dovizler.SelectSingleNode("ForexSelling").Text, ".", ",") & "'),CCur('" & _
            Replace(Dovizler.SelectSingleNode("BanknoteBuying").Text, ".", ",") & "'),CCur('" & _
            Replace(Dovizler.SelectSingleNode("BanknoteSelling").Text, ".", ",") & "'))"

baglan.Execute SqlEkle
       
Next
Set xmldoc = Nothing
döviz kısaltmasını doğrudan sayfadan alamadım o nedenle select case döngüsüne elle girildi
isim değişikliğinde sorun çıkabilir
@berduş hocam selamlar,

Tam tahmin ettiğim gibi yine döktürmüşsünüz, tekrar tekrar teşekkür ederim, bu aralar başınızı fazlasıyla ağrıtıyor olabilirim, hakkınızı helal edin hocam.

(06/05/2020, 03:54)feraz yazdı: Benimde çorbada katkım olsun.
berduş hocanın alltaki kodun altına
baglan.Open "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.Path & "\Döviz.accdb"
Alttaki kodu eklerseniz
Set rs = CreateObject("adodb.recordset")
rs.Open "delete * from Döviz", baglan, 1, 3
rs.Close

alttaki kodun altınada
Set xmldoc = Nothing
Alttaki kodu eklerseniz önce tablo silinir sonra listviewe veri gelir.
SqlEkle = "select * from [Döviz] WHERE not isnull([VeriTrh])"
rs.Open SqlEkle, baglan, 1, 3
Set rs = con.Execute(SqlEkle)
With ListView1
        .ListItems.Clear
        .ColumnHeaders.Clear
        For i = 0 To rs.Fields.Count - 1
            .ColumnHeaders.Add , , rs.Fields(i).Name
        Next i
        Do While Not rs.EOF
            ListView1.ListItems.Add , , rs(0).Value
            For a = 1 To rs.Fields.Count - 1
                ListView1.ListItems(ListView1.ListItems.Count).ListSubItems.Add , , IIf(IsNull(rs(a).Value) = True, " ", rs(a).Value)
            Next a
            rs.movenext
        Loop
End With
Set rs = Nothing
Set baglan = Nothing
rs.Close
baglan.Close
@feraz hocam saygılar,

Listviewi akşam hallederim derken cevabını gördüm. Sana da ayrıca teşekkür ederim.Tabloyu silmeden sadece textboxa girilen tarihe göre filtreleme yapılsa daha mı iyi olur sanki ?

Tabloda kurların arşivlenmesi mantıklı olacak gibi.
Son Düzenleme: 06/05/2020, 13:42, Düzenleyen: kanakan52.
Cevapla
#16
Keşke ben döktürmüş olsaydim)
Ben sadece ufak bir kaç değişiklik yaptım okadar.
Iyi çalışmalar.
Cevapla
#17
buton kodlarını aşağıdaki kodla değiştirip dener misiniz? böyle daha hızlı oldu sanki
Dim Adrs As String
Dim ParaBirim As String
SorguTarihi = CDate(Me.TxtTrh.Value)

Set xmldoc = CreateObject("Msxml.DOMDocument")
Dim DovizListesi, Dovizler As Object
xmldoc.async = False


If SorguTarihi <> Date Then

Adrs = "http://www.tcmb.gov.tr/kurlar/" & CStr(Format(SorguTarihi, "yyyymm") & "/" & Format(SorguTarihi, "ddmmyyyy")) & ".xml"

Else

Adrs = "http://www.tcmb.gov.tr/kurlar/today.xml"

End If
If URLExists(Adrs) = False Then
MsgBox "bu tarihe ait kayıt yok"
Exit Sub
End If
xmldoc.Load Adrs
Set DovizListesi = xmldoc.DocumentElement.SelectNodes("Currency")
On Error Resume Next

Set baglan = CreateObject("adodb.connection")
baglan.Open "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.Path & "\Döviz.accdb"

For Each Dovizler In DovizListesi
If Len(Dovizler.SelectSingleNode("BanknoteBuying").Text & "") = 0 Or Len(Dovizler.SelectSingleNode("BanknoteSelling").Text & "") = 0 Then
Exit For
End If
ParaBirim = Dovizler.SelectSingleNode("CurrencyName").Text

Select Case ParaBirim

Case "US DOLLAR"
txtDövizAdi = "USD"
Case "AUSTRALIAN DOLLAR"
txtDövizAdi = "AUD"
Case "DANISH KRONE"
txtDövizAdi = "DKK"
Case "EURO"
txtDövizAdi = "EUR"
Case "POUND STERLING"
txtDövizAdi = "GBP"
Case "SWISS FRANK"
txtDövizAdi = "CHF"
Case "SWEDISH KRONA"
txtDövizAdi = "SEK"
Case "CANADIAN DOLLAR"
txtDövizAdi = "CAD"
Case "KUWAITI DINAR"
txtDövizAdi = "KWD"
Case "NORWEGIAN KRONE"
txtDövizAdi = "NOK"
Case "SAUDI RIYAL"
txtDövizAdi = "SAR"
Case "JAPENESE YEN"
txtDövizAdi = "JPY"

End Select

SqlEkle = " INSERT INTO [Döviz] ([VeriTrh], DövizCinsi, DövizAdi, [DövizAlis], [DövizSatis],[EfektifAlis],[EfektifSatis]) " & _
" VALUES (" & CLng(SorguTarihi) & ",'" & txtDövizAdi & "','" & _
Dovizler.SelectSingleNode("Isim").Text & "'," & _
Dovizler.SelectSingleNode("ForexBuying").Text & ", " & _
Dovizler.SelectSingleNode("ForexSelling").Text & "," & _
Dovizler.SelectSingleNode("BanknoteBuying").Text & "," & _
Dovizler.SelectSingleNode("BanknoteSelling").Text & ")"

baglan.Execute SqlEkle

Next
Set xmldoc = Nothing
Cevapla
#18
(06/05/2020, 13:39)kanakan52 yazdı: .Tabloyu silmeden sadece textboxa girilen tarihe göre filtreleme yapılsa daha mı iyi olur sanki ?
Tabloda kurların arşivlenmesi mantıklı olacak gibi.
aynı tarihe ait aynı değer girilirse boş yere aynı kayıtlardan olur o nedenle aslında silinmesi daha mantıklı. silme koduna tarih kriteri eklenerek sadece girilen tarihin verilerinin silinmesi sağlanabilir
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task