,  , VBA
> > Basic > VBA

 
 
Spec_0994
0 / 0 / 0
: 01.11.2016
: 56
1

Access

27.06.2018, 06:40. 238. 4
( )

! , , 840, . VBA ?
0
    Access     
 : zip os_RateXML.zip (11.4 , 3 )
Similar
41792 / 34177 / 6122
: 12.04.2006
: 57,940
27.06.2018, 06:40
:


: ( ) Excel ...


, Excel. ...

Excel
, . xml ...


! . , ,...


.. . ...

4
192 / 139 / 30
: 13.12.2016
: 680
: 1
27.06.2018, 10:18 2
PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
Public Function GetCurrencyRate(rDate As Date, cCode As String) As Double
' Êóðñ áåð¸òñÿ ïî *äðåñó http://www.cbr.ru/currency_base/D_print.aspx?date_req=dd.mm.yyyy
' ãäå dd.mm.yyyy - ä*ò*, ** êîòîðóþ áåð¸ì êóðñ
' Â*ëþòû, äîñòóï*ûå ñ ýòîãî *äðåñ* ïåðå÷èñëå*û *èæå.
' rDate - ä*ò*, ** êîòîðóþ áåð¸ì êóðñ, cCode - êîä â*ëþòû,
' êóðñ êîòîðîé *åîáõîäèìî ïîëó÷èòü, â âèäå ñòðîêè èç 3-õ ñèìâîëîâ
'
' Êîäû â*ëþò:
' 36; AUD; 1; Àâñòð*ëèéñêèé äîëë*ð
' 974; BYR; 1000; Áåëîðóññêèõ ðóáëåé
' 208; DKK; 10; Ä*òñêèõ êðî*
' 840; USD; 1; Äîëë*ð ÑØÀ
' 978; EUR; 1; Åâðî
' 352; ISK; 100; Èñë**äñêèõ êðî*
' 398; KZT; 100; Ê*ç*õñêèõ òå*ãå
' 124; CAD; 1; Ê***äñêèé äîëë*ð
' 156; CNY; 10; Êèò*éñêèõ þ**åé Æý*üìè*üáè
' 949; TRY; 1; Íîâ*ÿ òóðåöê*ÿ ëèð*
' 578; NOK; 10; Íîðâåæñêèõ êðî*
' 960; XDR; 1; ÑÄÐ (ñïåöè*ëü*ûå ïð*â* ç*èìñòâîâ**èÿ)
' 702; SGD; 1; Ñè*ã*ïóðñêèé äîëë*ð
' 980; UAH; 10; Óêð*è*ñêèõ ãðèâå*
' 826; GBP; 1; Ôó*ò ñòåðëè*ãîâ Ñîåäè*å**îãî êîðîëåâñòâ*
' 752; SEK; 10; Øâåäñêèõ êðî*
' 756; CHF; 1; Øâåéö*ðñêèé ôð**ê
' 392; JPY; 100; ßïî*ñêèõ èå*
'
 
Dim sURI As String, oHttp As Object, HTMLcode, OutStr As String
Dim d As String, m As String, y As String, divider As Double
Dim foundRate As String, foundCount As String
Dim pLeft As Long, pRight As Long
 
GetCurrencyRate = 0
 
d = Format(rDate, "dd"): m = Format(rDate, "mm"): y = Format(rDate, "yyyy")
 
sURI = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" & d & "/" & m & "/" & y
      '"http://www.cbr.ru/scripts/XML_daily.asp?date_req=" & d & "%2F" & m & "%2F" & y
 
On Error Resume Next
Set oHttp = CreateObject("MSXML2.XMLHTTP")
If Err.Number <> 0 Then
Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
End If
On Error GoTo 0
If oHttp Is Nothing Then
Exit Function
End If
oHttp.Open "GET", sURI, False
oHttp.Send
HTMLcode = oHttp.responseText:  Set oHttp = Nothing
' îïðåäåëÿåì **÷*ëî ñòðîêè ñ èñêîìûì êîäîì â*ëþòû
pLeft = InStr(InStr(1, HTMLcode, UCase(cCode)) + Len(cCode), HTMLcode, "<Nominal>") + Len("<Nominal>")
' âûäåëÿåì ÷èñëî åäå*èö ç* êîòîðîå óê*ç*** öå**
pRight = InStr(pLeft, HTMLcode, "Nominal>")
foundCount = Mid(HTMLcode, pLeft, pRight - pLeft)
' ìåæäó ýòèìè ñêîáê*ìè **õîäèòñÿ öèôð* â âèäå ñòðîêè, êîòîð*ÿ ÿâëÿåòñÿ êîëè÷åñòâîì åäè*èö â*ëþòû, ïðåîáð*çîâûâ*åì â ÷èñëî
divider = Val(foundCount)
' èùåì êóðñ â*ëþòû
pLeft = InStr(pRight, HTMLcode, "Value") + Len("/Value")
pRight = InStr(pLeft, HTMLcode, "/Value") - 1
foundRate = Mid(HTMLcode, pLeft, pRight - pLeft)
' áåð¸ì ñèìâîëû êóðñ* â*ëþòû ìåæäó ýòèõ ãð**èö, ïðåîáð*çîâûâ*åì â òèï Double è äåëèì ** êîëè÷åñòâî åäè*èö â*ëþòû
GetCurrencyRate = CDbl(foundRate) / divider
'Í* *åêîòîðûå â*ëþòû êóðñ âûñò*âëÿåòñÿ *å êð*ò*ûé 1, ïîýòîìó äåëèì ** êð*ò*îñòü êóðñ*
End Function
20
GetCurrencyRate(rDate As Date, cCode As String)


0
Hugo121
6376 / 2454 / 428
: 19.10.2012
: 7,286
27.06.2018, 10:35 3
- .
0
Krapivnik
38 / 36 / 8
: 15.03.2018
: 87
27.06.2018, 11:29 4
Spec_0994
, 840, .
xml:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
For iIndex = 0 To nodeList.length - 1
   If InStr(nodeList.Item(iIndex).XML, "R01235") <> 0  
      '     iIndex       
       Set xmlNode = nodeList.Item(iIndex).cloneNode(True)
       '  " "
       strS = strS & ";" & xdate
 
      '      
        For i = 0 To xmlNode.childNodes.length - 1
         '    - 
              strS = strS & ";" & xmlNode.childNodes(i).Text
         Next
    End If
Next
R01235 - xml
1
 : zip RateXML2.zip (29.6 , 2 )
Krapivnik
38 / 36 / 8
: 15.03.2018
: 87
27.06.2018, 11:37 5
Krapivnik
xml:
Exit For End If

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
For iIndex = 0 To nodeList.length - 1
   If InStr(nodeList.Item(iIndex).XML, "R01235") <> 0  
      '     iIndex       
       Set xmlNode = nodeList.Item(iIndex).cloneNode(True)
       '  " "
       strS = strS & ";" & xdate
 
      '      
        For i = 0 To xmlNode.childNodes.length - 1
         '    - 
              strS = strS & ";" & xmlNode.childNodes(i).Text
         Next
     Exit For 
    End If
Next
1
27.06.2018, 11:37
MoreAnswers
37091 / 29110 / 5898
: 17.06.2006
: 43,301
27.06.2018, 11:37


( ) https://bitcoinity.org/ ,...


, . , ...

yandex.ru
c yandex.ru ! &lt;?php function...




:
5

- , ,
-
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.
@Mail.ru