Rambler's Top100
Форум: MS ACCESSVBVBA MS OfficeMS SQL server
Новые сообщения: 0000

Форум: MS ACCESS

Вопросы связанные с MS ACCESS

Обновить визитку
Участники «Online»
Все участники

 
 

Доброго времени суток, Посетитель!

вид форума:
Линейный форум Структурный форум

тема: Курс валюты
 
 автор: k@S   (24.11.2011 в 06:27)   личное сообщение
 
 

Как сделать если нет соединения с интернетом или сайт не отвечает вывести сообщение или просто закрыть форму не вешая ее.

Public Function CURS_USD(Дата)

Dim url_request As String
Dim nodeList As Object
Dim xmldoc As Object
Dim xmlNode As Object
Dim node_attr As Object

Dim i As Integer
Dim strS As String
Dim xdate As Date
Dim iIndex As Integer

Dim Цифр_код As String
Dim Курс As String

Set xmldoc = CreateObject("Msxml.DOMDocument")
xmldoc.async = False ' флаг асинхронной загрузки документа
' Адрес для получения курса
url_request = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(Nz(Дата, Date), "dd\/mm\/yyyy")
' загружаем документ по url
If Not xmldoc.Load(url_request) = True Then
MsgBox ("Документ не загружен")
Exit Function

End If

' список узлов XML документа с названием "ValCurs" В нашем случае он один
Set nodeList = xmldoc.selectNodes("ValCurs")
'Берем первый из списка
Set xmlNode = nodeList.Item(0).cloneNode(True)
' ищем атрибут с датой документа (будет найден последний документ от заданной даты)
Set node_attr = xmlNode.Attributes(0)
xdate = node_attr.Value
' коллекция узлов XML документа с названием "/Valute"
Set nodeList = xmldoc.selectNodes("*/Valute")
'строка заголовков для списка
'strS = "Дата;Код;Валюта;Номинал;Полное название;Курс"
'Цикл по всем элементам списка узлов
For iIndex = 0 To nodeList.length - 1
'получаем копию узла с индексом iIndex из коллекции узлов со всеми дочерними узлами
Set xmlNode = nodeList.Item(iIndex).cloneNode(True)
'Заполняем поле "дата курса"
' strS = strS & ";" & xdate
'цикл по всем дочерним узлам выбранного узла
For i = 0 To xmlNode.childNodes.length - 1
'значение узла записываем в строку-источник списка
If i = 0 And xmlNode.childNodes(i).Text = "840" Then
Курс = xmlNode.childNodes(i + 4).Text
CURS_USD = CDbl(Курс)
Exit Function
End If
Next
Next

End Function

  Ответить  
 
 автор: osmor   (24.11.2011 в 11:43)   личное сообщение
 
 

так уже есть

If Not xmldoc.Load(url_request) = True Then
MsgBox ("Документ не загружен")
Exit Function

  Ответить  
 
 автор: k@s   (24.11.2011 в 15:53)   личное сообщение
 
 

дело в том что база виснит пытаясь подключиться пока идет запрос

  Ответить  
 
 автор: час   (24.11.2011 в 18:50)   личное сообщение
 
 

В начале функции
on error goto Na_fig
.........................
....................
.........................
Exit Function
Na_fig:
msgbox "Отсутствует связь с серваком!"



хатя вряд ли поможет от зависания.
-----------------------------------------
Вынести в отдельный модуль
Закрыть форму и передать управление в модуль

Publick sub My_Connect
If Not xmldoc.Load(url_request) = True Then
MsgBox ("Документ не загружен")
Exit Function
end sub

и закрывать все форму - пытаясь подключиться.

  Ответить  
 
 автор: k@s   (25.11.2011 в 09:55)   личное сообщение
 
 

Спасибо буду пробовать

  Ответить  
HiProg.com - Технологии программирования
Rambler's Top100 TopList