(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.