Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Microsoft Access Новый топик    Ответить
 Курсы валют, импорт в Access.  [new]
wladimirrr
Member

Откуда: Калужская обл.
Сообщений: 288
Приветствую всех! Доработал немного бд RateXML, который нашёл на этом форуме. Теперь он скачивает и курсы ЦБ Белоруссии. Только не знаю, как эти данные дальше экспортировать в таблицу для дальнейшего использования. Давайте что нибудь придумаем, я думаю, эта операция довольно востребована.

К сообщению приложен файл (RateXML2.rar - 24Kb) cкачать
2 июл 16, 12:15    [19362447]     Ответить | Цитировать Сообщить модератору
 Re: Курсы валют, импорт в Access.  [new]
Sub q
Guest
wladimirrr,

Sub q()
On Error Resume Next
    Dim url_request As String
    Dim xmlDoc As MSXML2.DOMDocument 'Object
    Dim FileName As String
    '
    Set xmlDoc = CreateObject("Msxml2.DOMDocument")
    xmlDoc.async = False ' флаг асинхронной загрузки документа
    ' Адрес для получения курса
    url_request = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(Date, "dd\/mm\/yyyy")
    ' загружаем документ по url
    If Not xmlDoc.Load(url_request) = True Then
       MsgBox ("Документ не загружен")
       Exit Sub
    End If
    '
    FileName = CurrentProject.Path & "\temp.xml"
    Kill FileName
    xmlDoc.Save FileName
    Set xmlDoc = Nothing
    '
    CurrentDb.Execute "drop table Valute"
    Application.ImportXML FileName, acStructureAndData
    '
    DoCmd.OpenTable "Valute"
End Sub
2 июл 16, 21:35    [19363493]     Ответить | Цитировать Сообщить модератору
 Re: Курсы валют, импорт в Access.  [new]
Ёжик`
Member

Откуда:
Сообщений: 5992
Public Function GetVal1()
On Error GoTo er
    Dim xmlDoc As Object, xmlNode As Object
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    xmlDoc.async = False
    xmlDoc.Load "http://www.nbrb.by/Services/XmlExRates.aspx?ondate=" + Format(Date, "mm\/dd\/yyyy")
'    Debug.Print xmlDoc.XML
'    Debug.Print "--------------------------------------------------------------------"
    
    ' USD Id=145 Доллар США
    Set xmlNode = xmlDoc.DocumentElement.SelectSingleNode("Currency[@Id='145']")
    Debug.Print xmlNode.Text, "Rate="; Val(xmlNode.SelectSingleNode("Rate").Text)
    Debug.Print "--------------------------------------------------------------------"

    ' EUR Id=292 Евро
    Debug.Print "Евро="; CCur(Val(xmlDoc.DocumentElement.SelectSingleNode("Currency[@Id='292']/Rate").Text))
    Debug.Print "--------------------------------------------------------------------"
        
    ' CZK Id=305 Чешских крон
    Set xmlNode = xmlDoc.DocumentElement.SelectSingleNode("Currency[@Id='305']")
    Debug.Print xmlNode.Text
    Debug.Print xmlNode.SelectSingleNode("NumCode").Text
    Debug.Print xmlNode.SelectSingleNode("CharCode").Text
    Debug.Print xmlNode.SelectSingleNode("Scale").Text
    Debug.Print xmlNode.SelectSingleNode("Name").Text
    Debug.Print xmlNode.SelectSingleNode("Rate").Text
    Debug.Print "--------------------------------------------------------------------"
    
ex: Exit Function
er: MsgBox Err.Description, vbCritical, "CmdGetVal1"
End Function
2 июл 16, 22:54    [19363662]     Ответить | Цитировать Сообщить модератору
 Re: Курсы валют, импорт в Access.  [new]
wladimirrr
Member

Откуда: Калужская обл.
Сообщений: 288
Ёжик`, пока не разобрался, как этот код использовать, что-бы он работал. У меня не тот уровень, в основном работаю с макросами. (не смейтесь, я не программист, с access работаю давно, коды только начал изучать). Хотелось бы разобраться на примере работающего кода.
3 июл 16, 14:40    [19364446]     Ответить | Цитировать Сообщить модератору
 Re: Курсы валют, импорт в Access.  [new]
wladimirrr
Member

Откуда: Калужская обл.
Сообщений: 288
Sub q, код не работает. Может я что-то не так делаю?
3 июл 16, 14:41    [19364449]     Ответить | Цитировать Сообщить модератору
 Re: Курсы валют, импорт в Access.  [new]
wladimirrr
Member

Откуда: Калужская обл.
Сообщений: 288
Sub q, заменил строку: Dim xmlDoc As MSXML2.DOMDocument 'Object на: Dim xmlDoc As Object 'Object и все заработало. Таблица формируется. Только значение курсов в текстовом формате. Как можно преобразовать в таблице текст типа "1.1111" в числовой формат?
5 июл 16, 18:13    [19372307]     Ответить | Цитировать Сообщить модератору
 Re: Курсы валют, импорт в Access.  [new]
wladimirrr
Member

Откуда: Калужская обл.
Сообщений: 288
Вспомнил, Val))
5 июл 16, 18:18    [19372324]     Ответить | Цитировать Сообщить модератору
 Re: Курсы валют, импорт в Access.  [new]
wladimirrr
Member

Откуда: Калужская обл.
Сообщений: 288
Настроил код, загружает курсы в таблицу "Currency", но каждый раз создает новую, а старой присваивает к имени 1,2,3...
В коде есть команда: CurrentDb.Execute "drop table Currency", которая должна удалять старую таблицу, но почему-то не удаляет. Посмотрите опытным взглядом, где "собака зарыта"?

Private Sub Êíîïêà20_Click()
On Error Resume Next
    Dim url_request As String
    Dim xmlDoc As Object 'Object
    Dim FileName As String
    '
    Set xmlDoc = CreateObject("Msxml2.DOMDocument")
    xmlDoc.async = False ' ôëàã àñèíõðîííîé çàãðóçêè äîêóìåíòà
    ' Àäðåñ äëÿ ïîëó÷åíèÿ êóðñà
    url_request = "http://www.nbrb.by/Services/XmlExRates.aspx?ondate=" + Format(Nz(Me!dtRate, Date), "mm\/dd\/yyyy")
    ' çàãðóæàåì äîêóìåíò ïî url
    If Not xmlDoc.Load(url_request) = True Then
       MsgBox ("Äîêóìåíò íå çàãðóæåí")
       Exit Sub
    End If
    '
    FileName = CurrentProject.Path & "\temp.xml"
    Kill FileName
    xmlDoc.Save FileName
    Set xmlDoc = Nothing
    '
    CurrentDb.Execute "drop table Currency"
    Application.ImportXML FileName, acStructureAndData
    '
    DoCmd.OpenTable "Currency"
End Sub
5 июл 16, 20:07    [19372608]     Ответить | Цитировать Сообщить модератору
 Re: Курсы валют, импорт в Access.  [new]
wladimirrr
Member

Откуда: Калужская обл.
Сообщений: 288
Код ещё раз.
Private Sub Êíîïêà20_Click()
On Error Resume Next
    Dim url_request As String
    Dim xmlDoc As Object 'Object
    Dim FileName As String
    '
    Set xmlDoc = CreateObject("Msxml2.DOMDocument")
    xmlDoc.async = False ' ôëàã àñèíõðîííîé çàãðóçêè äîêóìåíòà
    ' Àäðåñ äëÿ ïîëó÷åíèÿ êóðñà
    url_request = "http://www.nbrb.by/Services/XmlExRates.aspx?ondate=" + Format(Nz(Me!dtRate, Date), "mm\/dd\/yyyy")
    ' çàãðóæàåì äîêóìåíò ïî url
    If Not xmlDoc.Load(url_request) = True Then
       MsgBox ("Äîêóìåíò íå çàãðóæåí")
       Exit Sub
    End If
    '
    FileName = CurrentProject.Path & "\temp.xml"
    Kill FileName
    xmlDoc.Save FileName
    Set xmlDoc = Nothing
    '
    CurrentDb.Execute "drop table Currency"
    Application.ImportXML FileName, acStructureAndData
    '
    DoCmd.OpenTable "Currency"
End Sub
5 июл 16, 20:09    [19372614]     Ответить | Цитировать Сообщить модератору
 Re: Курсы валют, импорт в Access.  [new]
wladimirrr
Member

Откуда: Калужская обл.
Сообщений: 288
Что-то с редактором не могу разобраться. Предварительный просмотр отображает нормально, а публикует фигню((
5 июл 16, 20:11    [19372619]     Ответить | Цитировать Сообщить модератору
 Re: Курсы валют, импорт в Access.  [new]
mds_world
Member

Откуда: Ташкент
Сообщений: 27514
Копируйте код из редактора ВБА при включенной русской раскладке
5 июл 16, 20:40    [19372688]     Ответить | Цитировать Сообщить модератору
 Re: Курсы валют, импорт в Access.  [new]
Sub q
Guest
wladimirrr
Настроил код, загружает курсы в таблицу "Currency", но каждый раз создает новую, а старой присваивает к имени 1,2,3...
В коде есть команда: CurrentDb.Execute "drop table Currency", которая должна удалять старую таблицу, но почему-то не удаляет. Посмотрите опытным взглядом, где "собака зарыта"?

Она (таблица или форма на таблице) у тебя открыта, когда ты её удаляешь
5 июл 16, 21:37    [19372870]     Ответить | Цитировать Сообщить модератору
 Re: Курсы валют, импорт в Access.  [new]
wladimirrr
Member

Откуда: Калужская обл.
Сообщений: 288
Sub q
Это Ваш исходный код и он успешно удаляет таблицу "Valute" при повторном вызове. Я заменил в нем адрес для получения курса, теперь он формирует таблицу "Currency", но не удаляет при повторном вызове, а добавляет Currency1, Currency2 и т.д.

Sub q()
On Error Resume Next
    Dim url_request As String
    Dim xmlDoc As MSXML2.DOMDocument 'Object
    Dim FileName As String
    '
    Set xmlDoc = CreateObject("Msxml2.DOMDocument")
    xmlDoc.async = False ' флаг асинхронной загрузки документа
    ' Адрес для получения курса
    url_request = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(Date, "dd\/mm\/yyyy")
    ' загружаем документ по url
    If Not xmlDoc.Load(url_request) = True Then
       MsgBox ("Документ не загружен")
       Exit Sub
    End If
    '
    FileName = CurrentProject.Path & "\temp.xml"
    Kill FileName
    xmlDoc.Save FileName
    Set xmlDoc = Nothing
    '
    CurrentDb.Execute "drop table Valute"
    Application.ImportXML FileName, acStructureAndData
    '
    DoCmd.OpenTable "Valute"
End Sub
5 июл 16, 22:10    [19372986]     Ответить | Цитировать Сообщить модератору
Между сообщениями интервал более 1 года.
 Re: Курсы валют, импорт в Access.  [new]
Медет
Member

Откуда:
Сообщений: 9
Sub q
wladimirrr,

Sub q()
On Error Resume Next
    Dim url_request As String
    Dim xmlDoc As MSXML2.DOMDocument 'Object
    Dim FileName As String
    '
    Set xmlDoc = CreateObject("Msxml2.DOMDocument")
    xmlDoc.async = False ' флаг асинхронной загрузки документа
    ' Адрес для получения курса
    url_request = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(Date, "dd\/mm\/yyyy")
    ' загружаем документ по url
    If Not xmlDoc.Load(url_request) = True Then
       MsgBox ("Документ не загружен")
       Exit Sub
    End If
    '
    FileName = CurrentProject.Path & "\temp.xml"
    Kill FileName
    xmlDoc.Save FileName
    Set xmlDoc = Nothing
    '
    CurrentDb.Execute "drop table Valute"
    Application.ImportXML FileName, acStructureAndData
    '
    DoCmd.OpenTable "Valute"
End Sub

Здравствуйте!

Установил себе этот код и он отлично работает, но берет данные с ЦРБ! Подскажите как взять данные с адреса Казахского национального банка?
29 май 19, 11:33    [21896501]     Ответить | Цитировать Сообщить модератору
 Re: Курсы валют, импорт в Access.  [new]
Serg197311
Member

Откуда:
Сообщений: 414
url_request = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(Date, "dd\/mm\/yyyy")

Эту строку менять пробовали?
29 май 19, 11:46    [21896522]     Ответить | Цитировать Сообщить модератору
 Re: Курсы валют, импорт в Access.  [new]
Прогер_самоучка
Member

Откуда:
Сообщений: 67799
Медет
Sub q
wladimirrr,

Sub q()
On Error Resume Next
    Dim url_request As String
    Dim xmlDoc As MSXML2.DOMDocument 'Object
    Dim FileName As String
    '
    Set xmlDoc = CreateObject("Msxml2.DOMDocument")
    xmlDoc.async = False ' флаг асинхронной загрузки документа
    ' Адрес для получения курса
    url_request = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(Date, "dd\/mm\/yyyy")
    ' загружаем документ по url
    If Not xmlDoc.Load(url_request) = True Then
       MsgBox ("Документ не загружен")
       Exit Sub
    End If
    '
    FileName = CurrentProject.Path & "\temp.xml"
    Kill FileName
    xmlDoc.Save FileName
    Set xmlDoc = Nothing
    '
    CurrentDb.Execute "drop table Valute"
    Application.ImportXML FileName, acStructureAndData
    '
    DoCmd.OpenTable "Valute"
End Sub


Здравствуйте!

Установил себе этот код и он отлично работает, но берет данные с ЦРБ! Подскажите как взять данные с адреса Казахского национального банка?
+ У них и спросите
Телефон справочной службы: + 7 (727) 2704-591
e-mail: hq@nationalbank.kz

По крайней мере, я сходу не нашёл. Только кнопочка "выгрузить в эксель" вот тут
29 май 19, 11:56    [21896540]     Ответить | Цитировать Сообщить модератору
 Re: Курсы валют, импорт в Access.  [new]
Медет
Member

Откуда:
Сообщений: 9
Serg197311,
пробовал вставить
эту строчку
http://www.w3.org/TR/html4/loose.dtd
с сайта www.nationalbank.kz

вышло окно - Документ не загружен!

может кто подскажет, может что то не так делаю?
29 май 19, 16:26    [21896988]     Ответить | Цитировать Сообщить модератору
 Re: Курсы валют, импорт в Access.  [new]
Медет
Member

Откуда:
Сообщений: 9
разобрался!
подставил строку
http://nationalbank.kz/?getpg=outurl&out=https://nationalbank.kz/rss/get_rates.cfm?fdate=

и все получилось!
29 май 19, 16:33    [21897005]     Ответить | Цитировать Сообщить модератору
 Re: Курсы валют, импорт в Access.  [new]
Медет
Member

Откуда:
Сообщений: 9
что необходимо исправить в коде, чтобы при каждом запросе не формировались новые таблицы?
29 май 19, 16:43    [21897024]     Ответить | Цитировать Сообщить модератору
 Re: Курсы валют, импорт в Access.  [new]
Медет
Member

Откуда:
Сообщений: 9
Думал помогут тут быстро, но сам разобрался. Выкладываю код для загрузки курса валют с национального банка казахстана

Private Sub Кнопка4_Click()
On Error Resume Next
    Dim url_request As String
    Dim xmlDoc As Object 'Object
    Dim FileName As String
    '
    Set xmlDoc = CreateObject("Msxml2.DOMDocument")
    xmlDoc.async = False ' флаг асинхронной загрузки документа
    ' Адрес для получения курса
    url_request = "http://nationalbank.kz/?getpg=outurl&out=https://nationalbank.kz/rss/get_rates.cfm?fdate=" + Format(Date, "dd\/mm\/yyyy")
    ' загружаем документ по url
    If Not xmlDoc.Load(url_request) = True Then
       MsgBox ("Документ не загружен")
       Exit Sub
    End If
    '
    FileName = CurrentProject.Path & "\temp.xml"
    DoCmd.DeleteObject acTable, "item"
    DoCmd.DeleteObject acTable, "rates"
    xmlDoc.Save FileName
    Set xmlDoc = Nothing
    '
    CurrentDb.Execute "drop table Valute"
    Application.ImportXML FileName, acStructureAndData
    '
    DoCmd.OpenTable "Valute"
End Sub
29 май 19, 17:07    [21897081]     Ответить | Цитировать Сообщить модератору
Все форумы / Microsoft Access Ответить