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

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

Access'e doğrudan aşağıdaki kodlar ile alabilirsin.

(06/05/2020, 06:23)alicimri yazdı: Access'e doğrudan aşağıdaki kodlar ile alabilirsin.

Kod:

Sub TestExportXML()
Application.ImportXML _
DataSource:="https://www.tcmb.gov.tr/kurlar/today.xml", _
ImportOptions:=acAppendData

End Sub

bu çok kısa güzel bir kod ama hangi tabloya hangi alanlara neyi alıyor

tablo seçilemiyor galiba
ama 3 farklı seçeneği var
Application.ImportXML Adrs, acAppendData ise : xml dosyasından aldığı isimde tablo varsa, alan adları aynı olan alanları dolduruyor, eğer o adda bir tablo yoksa oluşturuyor galiba.
Application.ImportXML Adrs, acStructureAndData ise : tablo yoksa tabloyu verileriyle oluşturuyor, eğer tablo varsa sonuna sayı ekleyerek yeniden oluşturuyor
Application.ImportXML Adrs, acStructureOnly ise : tabloyu verileri almadan oluşturur

Kodları bir modül oluşturup ona yapıştırıp çalıştırın. "Currency" adında bir tablo oluşacaktır.
Aynı kodu tekrar çalıştırırsanız, verileri bu tabloya ekleyecektir.
Tabi bir form oluşturup Metin kutusundaki tarihe göre de aldırmak mümkün.
Not: Eğer ilk oluşan tablodan istemediğiniz alanları silerseniz. daha sonra eklemelerde sadece silmediğiniz alanlara veri ekler.