Всем привет! Не могу разобраться и уже голову всю сломал. У меня есть код, который вытягивает курсы валют по дням с сайта ЦБ: [vba]
Код
Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Date) As Double ' функция возвращает курс валюты CurrencyName на дату RateDate ' в случае ошибки (неверная дата или название валюты) возвращается 0 On Error Resume Next CurrencyName = UCase(CurrencyName): If Len(CurrencyName) <> 3 Then Exit Function Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False url_request = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(RateDate, "dd\/mm\/yyyy")
If xmldoc.Load(url_request) <> True Then MsgBox "Не удалось получить данные!", vbCritical, "Критическая ошибка!" ' Запрос к серверу ЦБР Exit Function End If
' Обработка полученного ответа Set nodeList = xmldoc.SelectNodes("ValCurs"): Set xmlNode = nodeList.Item(0).CloneNode(True) Set node_attr = xmlNode.Attributes(0): strDate = node_attr.Value Set nodeList = xmldoc.SelectNodes("*/Valute") For i = 0 To nodeList.Length - 1 ' поиск нужной валюты Set xmlNode = nodeList.Item(i).CloneNode(True) If xmlNode.ChildNodes(1).Text = CurrencyName Then CurrencyRate = CDbl(xmlNode.ChildNodes(4).Text) divisor = Val(xmlNode.ChildNodes(2).Text) GetRate = CurrencyRate / divisor Exit Function End If Next End Function
[/vba]
Хочу сделать такую же штуку по нефти. Понятное дело, что ЦБ нефтью не торгует. Хочу выгрузить с Финама или РБК, но совсем не пойму, как это сделать. Буду признателен!
Всем привет! Не могу разобраться и уже голову всю сломал. У меня есть код, который вытягивает курсы валют по дням с сайта ЦБ: [vba]
Код
Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Date) As Double ' функция возвращает курс валюты CurrencyName на дату RateDate ' в случае ошибки (неверная дата или название валюты) возвращается 0 On Error Resume Next CurrencyName = UCase(CurrencyName): If Len(CurrencyName) <> 3 Then Exit Function Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False url_request = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(RateDate, "dd\/mm\/yyyy")
If xmldoc.Load(url_request) <> True Then MsgBox "Не удалось получить данные!", vbCritical, "Критическая ошибка!" ' Запрос к серверу ЦБР Exit Function End If
' Обработка полученного ответа Set nodeList = xmldoc.SelectNodes("ValCurs"): Set xmlNode = nodeList.Item(0).CloneNode(True) Set node_attr = xmlNode.Attributes(0): strDate = node_attr.Value Set nodeList = xmldoc.SelectNodes("*/Valute") For i = 0 To nodeList.Length - 1 ' поиск нужной валюты Set xmlNode = nodeList.Item(i).CloneNode(True) If xmlNode.ChildNodes(1).Text = CurrencyName Then CurrencyRate = CDbl(xmlNode.ChildNodes(4).Text) divisor = Val(xmlNode.ChildNodes(2).Text) GetRate = CurrencyRate / divisor Exit Function End If Next End Function
[/vba]
Хочу сделать такую же штуку по нефти. Понятное дело, что ЦБ нефтью не торгует. Хочу выгрузить с Финама или РБК, но совсем не пойму, как это сделать. Буду признателен!akobir
Вы укажите адреса сайтов, тогда можно что-то сказать. А Ваш код работает с XML файлом, причем отбирает узлы Valute. Вряд ли на других сайтах такое.
Вы укажите адреса сайтов, тогда можно что-то сказать. А Ваш код работает с XML файлом, причем отбирает узлы Valute. Вряд ли на других сайтах такое.Udik
вот вам барабан яд 41001231307558 wm R419131876897 udik1968@gmail.com
На этом адресе (финам) только на текущий день. Ну такая заготовка [vba]
Код
Option Explicit
Public Sub tt() Dim txt As String Dim RegExp As Object Dim rezFind As Object, unoRez As Object Dim xhr
Set xhr = CreateObject("WinHttp.WinHttpRequest.5.1") xhr.Open "GET", "http://www.finam.ru/profile/tovary/brent/", False xhr.send txt = xhr.responseText Set RegExp = CreateObject("VBScript.RegExp") With RegExp .Global = True 'Нужны все совпадения .IgnoreCase = True 'Регистр неважен .Pattern = "issuer-profile-informer.+span>" 'Регулярка End With Set rezFind = RegExp.Execute(txt) End Sub
[/vba] потом из rezFind нужное отобрать. А на РБК постоянно окошко логин/пароль вылазит .
На этом адресе (финам) только на текущий день. Ну такая заготовка [vba]
Код
Option Explicit
Public Sub tt() Dim txt As String Dim RegExp As Object Dim rezFind As Object, unoRez As Object Dim xhr
Set xhr = CreateObject("WinHttp.WinHttpRequest.5.1") xhr.Open "GET", "http://www.finam.ru/profile/tovary/brent/", False xhr.send txt = xhr.responseText Set RegExp = CreateObject("VBScript.RegExp") With RegExp .Global = True 'Нужны все совпадения .IgnoreCase = True 'Регистр неважен .Pattern = "issuer-profile-informer.+span>" 'Регулярка End With Set rezFind = RegExp.Execute(txt) End Sub
[/vba] потом из rezFind нужное отобрать. А на РБК постоянно окошко логин/пароль вылазит .Udik
вот вам барабан яд 41001231307558 wm R419131876897 udik1968@gmail.com
Сообщение отредактировал Udik - Четверг, 19.01.2017, 21:11