Moderátor: Mods_senior
) radu!
Kód: Vybrat vše
Option Explicit
Sub DenniKurzyCNB()
Dim Dat As Date, Mena As String, URL As String, objHTTP As Object
Dim PoleTemp, PolePom, i As Integer, j As Byte
Dim Pole(), TargetCll As Range
'
Dat = Format(Now, "dd.mm.yyyy") ' datum pro posledni platny stav kurzu, novy v prac dny po 14:30
'adresa odkazu (CNB)
URL = "http://www.cnb.cz/cs/financni_trhy/devizovy_trh/kurzy_devizoveho_trhu/denni_kurz.txt?date=" & Dat
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
Call objHTTP.Open("GET", URL, False)
objHTTP.Send
'
' 'výpis do okna Immediate
' Debug.Print (objHTTP.responseText)
'
'pole pro vypreparování údajù
PoleTemp = Split(objHTTP.responseText, vbLf) ' novy radek; za posl pol je take vbLf, coz prida prazdnou polozku!
'
' 'výpis do okna Immediate
' i = 0
' Do
' Debug.Print i; " * "; PoleTemp(i)
' i = i + 1
' Loop While i < UBound(PoleTemp)
'
' separace do Pole a vlozeni do listu
Set TargetCll = Worksheets("list2").Range("a1")
ReDim Pole(UBound(PoleTemp), 4)
i = 0
Mena = "EUR"
Do
'************* tato cast jen pro EUR do msgboxu
If InStr(PoleTemp(i), Mena) > 0 Then
PolePom = Split(PoleTemp(i), "|")
MsgBox PolePom(2) & " " & PolePom(3) & " " & PolePom(4)
End If
'************ tato cast pro vsechny meny do listu
PolePom = Split(PoleTemp(i), "|")
j = 0
Do
If i > 1 And j = 4 Then
' ve vypisu je oddelovac desetinnych cisel ",", pro VBA nutno zmenit na "."
' Pole(i, j) = Val(Replace(PolePom(j), ",", "."))
TargetCll.Offset(i, j).Value = Val(Replace(PolePom(j), ",", "."))
Else
Pole(i, j) = PolePom(j)
TargetCll.Offset(i, j).Value = PolePom(j)
End If
j = j + 1
Loop While j < UBound(PolePom) + 1
'***********
i = i + 1
Loop While i < UBound(PoleTemp)
'
TargetCll.Resize(UBound(PoleTemp), 5).Columns.AutoFit
'
End Sub
