ник: k@S
Как сделать если нет соединения с интернетом или сайт не отвечает вывести сообщение или просто закрыть форму не вешая ее.
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