Здравствуйте, уважаемые форумчане. Я в VBA не очень (учусь) и с такими задачами еще не сталкивался (в основном работаю с таблицами/листами/ячейками), - руководство поставило задачу сделать макрос проверки параметров сайта в Excel на основании API c сервиса recipdonor.com (пытаюсь сделать такой запрос: Проверка тИЦ). 4-й день уже гуглю и читаю форумы, вроде все более-менее понятно, но у меня никак не получается получить ответ на запрос.. Подскажите пож-та, что я делаю не так. Я думал, логически, ничего сложного не должно быть - интернет есть - разберусь, а ничего не получается..((
Код
Sub Zapros()
Set HTTP = CreateObject("MSXML2.XMLHTTP")
apiBase64 = "Basic RjkxNjhDNUUtQ0VCMi00ZmFhLUI2QkYtMzI5QkYzOUZBMUU0Ong="
sURL1 = "http://recipdonor.com/api/session/new HTTP/1.1"
sql1 = "<InitSession><Parameters><TaskVariant>Cy</TaskVariant></Parameters><DomainNames><string>mozilla.com</string></DomainNames><Refresh>true</Refresh></InitSession>"
HTTP.Open "PUT", sURL1, True
HTTP.SetRequestHeader "Host", "recipdonor.com:977"
HTTP.SetRequestHeader "Content-type", "text/xml; charset=utf-8"
HTTP.SetRequestHeader "Authorization", apiBase64
HTTP.SetRequestHeader "Content-Length", Len(sql1)
HTTP.send sql1
Do While HTTP.readyState <> 4
DoEvents
Loop
otvet = HTTP.responseText
[A1].Value = otvet
End Sub
Сам макрос выполняется - но результат "0", точнее - нет ответа..(( Буду премного благодарен за помощь. Спасибо.
Положу еще здесь описание API для даного запроса с сайта recipdonor.com: Проверка тИЦ, Я.Каталог и Зеркало Для осуществления проверки тИЦ используются два API метода /session/new и /session/get. В примере мы проверим на тИЦ сразу несколько сайтов mozilla.com, mozilla.ru, google.com, msdn.microsoft.com. Инициализация проверки осуществляется методом /session/new. Создадим проверку послав в API запрос вида:
что говорит об успешном создании сессии проверки, где Id - уникальный идентификатор сессии ExpireAt - сессия будет уничтожена в указанное время SessionStatus - Статус ToCheck говорит нам о том, что сессия поставлена на проверку
Системе на проверку параметра тИЦ может уйти некоторое время, ответ вы можете получить не сразу. Для получения результатов проверки необходимо использовать метод /session/get
Здравствуйте, уважаемый, Игорь! И еще раз, здравствуйте, уважаемый Doober! Спасибо большое за помощь! С XML заморачивался, потому что на сайте recipdonor.com в описании API написано: "RDS API для получения и выдачи данных использует форматы JSON и XML. По умолчанию используется формат XML." + обязательно указывать "Content-type", "text/xml; charset=utf-8" Так как с про JSON я только краем уха где-то слышал - решил работать с XML, хотя и с ним не работал, но хотя бы видел его много раз..))
Попробовал макрос с Вашими правками - и теперь совсем запутался..(( 1. Макрос возвращает ответ - HTML-страница ошибки.. 2. В который раз прошелся по справке АПИ на сайте recipdonor.com и увидел ссылку на страницу тестирования запросов в АПИ - http://www.recipdonor.com/help/apitest, на которой видно, что в конце строки ссылки надо указывать "?format=xml", т.е., ссылка должна выглядеть так: "http://recipdonor.com:977/api/session/new?format=xml" в таком случае, сервер нормально принимает запрос и возвращает ответ в формате XML. Если же в ссылке оставить в конце " HTTP/1.1", то запрос в формате XML отправляется нормально, но ответ приходит в формате JSON. Одним словом, получается что некоторые части справки противоречат друг другу - наверно что-то менялось в API, но не везде в описании поправили. Таким образом - с Вашей помощью, Doober и Игорь, разобрался! Спасибо Вам Огромное! Извините, если надоел Вам - несколько суток без нормального сна.. Макросы, которые получились в конечном итоге: 1. Отправка запроса в формате XML:
Скрытый текст
Код
Sub Zapros()
Set HTTP = CreateObject("MSXML2.XMLHTTP")
apiBase64 = "Basic RjkxNjhDNUUtQ0VCMi00ZmFhLUI2QkYtMzI5QkYzOUZBMUU0Ong="
sURL1 = "http://recipdonor.com:977/api/session/new?format=xml"
sql1 = "<InitSession><Parameters><TaskVariant>Cy</TaskVariant></Parameters><DomainNames><string>mozilla.com</string></DomainNames><Refresh>true</Refresh></InitSession>"
HTTP.Open "PUT", sURL1, True
HTTP.SetRequestHeader "Host", "recipdonor.com:977"
HTTP.SetRequestHeader "Content-type", "text/xml; charset=utf-8"
HTTP.SetRequestHeader "Authorization", apiBase64
HTTP.SetRequestHeader "Content-Length", Len(sql1)
HTTP.send sql1
Do While HTTP.readyState <> 4
DoEvents
Loop
[A1].Value = HTTP.responseText
End Sub
С ответа берем Id сессии (38fa4bcd-ee36-4cb5-992b-96068a87f4d6) и используем его в следующем запросе на получение данных: 2. Запрос на получение данных в формате XML:
Скрытый текст
Код
Sub ZaprosEnd()
Set HTTP = CreateObject("MSXML2.XMLHTTP")
apiBase64 = "Basic RjkxNjhDNUUtQ0VCMi00ZmFhLUI2QkYtMzI5QkYzOUZBMUU0Ong="
sURL1 = "http://recipdonor.com:977/api/session/get?id=38fa4bcd-ee36-4cb5-992b-96068a87f4d6&format=xml"
sql1 = "<InitSession><Parameters><TaskVariant>Cy</TaskVariant></Parameters><DomainNames><string>mozilla.com</string></DomainNames><Refresh>true</Refresh></InitSession>"
HTTP.Open "GET", sURL1, True
HTTP.SetRequestHeader "Host", "recipdonor.com:977"
HTTP.SetRequestHeader "Content-type", "text/xml; charset=utf-8"
HTTP.SetRequestHeader "Authorization", apiBase64
HTTP.send
Do While HTTP.readyState <> 4
DoEvents
Loop
[A2].Value = HTTP.responseText
End Sub
А тем, кто хочет получать данные в формате JSON надо совсем чуть-чуть поменять в запросах: в обоих запросах в конец ссылки добавить " HTTP/1.1", например, в первом запросе строка со ссылкой должна быть такой: sURL1 = "http://recipdonor.com:977/api/session/new?format=xml HTTP/1.1"
Вроде бы все расписал - вдруг кому пригодится. Остался один вопрос - может подскажете готовое решение или ткнете носом куда-то: Как быстро разбирать эти полученные ответы в формате XML? Заранее, спасибо.
'Ваш код
HTTP.send
Do While HTTP.readyState <> 4
DoEvents
Loop
Set xmlDoc = HTTP.responseXML
Set ids = xmlDoc.SelectSingleNode("//Id")
If Not ids Is Nothing Then
ID = ids.Text
End If
Set ids = xmlDoc.SelectSingleNode("//Cy")
If Not ids Is Nothing Then
Cy = ids.Text
End If
Set ids = xmlDoc.SelectSingleNode("//Yaca")
If Not ids Is Nothing Then
Yaca = ids.Text
End If
Set ids = xmlDoc.SelectSingleNode("//YaBarMirrow")
If Not ids Is Nothing Then
YaBarMirrow = ids.Text
End If
[A2].Value = HTTP.responseText
End Sub
NaMoRZA написал: только не могу придумать как это правильно делать, если у нас больше 1 значения?:
Думать не надо,надо по ссылке предложенной сходить
Код
xmlDoc.setProperty "SelectionLanguage", "XPath"
XPath = "//DomainData"
Set objListOfNodes = xmlDoc.SelectNodes(XPath)
for n=0 to objListOfNodes.Length
For Each objNode In objListOfNodes(n).ChildNodes
Select Case objNode.BaseName
Case "DomainName"
DomainName = objNode.Text
Case "Data"
Parameter = objNode.ChildNodes(0).Text
For Each oNod In objNode.ChildNodes(1).ChildNodes
Select Case oNod.BaseName
case "Cy"
Cy= oNod.Text
case "Yaca"
Yaca= oNod.Text
case "YaBarMirrow"
YaBarMirrow= oNod.Text
End Select
next
End Select
Next
next
Не проверял,писал в блокноте.Идея должна быть вам понятна
Разбирать XML, если в нем больше одного элемента "DomainName".
Цитата
Doober написал: Думать не надо,надо по ссылке предложенной сходить
Извините, не увидел ссылку..
Цитата
Doober написал: Не проверял,писал в блокноте.Идея должна быть вам понятна
Разбор выбирает только DomainName, потом вываливает ошибку Run time error 91: Object variable or With block variable not set. на строке "For Each objNode In objListOfNodes(n).ChildNodes". Я посмотрел - в момент ошибки, n = 2. Идея понятна, почитал про XPath - удобная штука.) Вроде бы все понятно, кроме нескольких нюансов. Напишу, а Вы поправьте пож-та, если что-то не верно, чтобы я уже не задавал дурных вопросов:
Код
'указаваем параметры (язык) для документа xmlDoc
xmlDoc.setProperty "SelectionLanguage", "XPath"
'указываем на корневой элемент
XPath = "//DomainData"
'присваиваем objListOfNodes список всех элементов корневого элемента
Set objListOfNodes = xmlDoc.SelectNodes(XPath)
' тут немного не понятно - если objListOfNodes - это список элементов, то какой смысл в цикле перебирать его длину(Length)?
For n = 0 To objListOfNodes.Length
'делаем проверку всех дочерних элементов(ChildNodes) из objListOfNodes? не понятно, что такое в данном случае (n)
For Each objNode In objListOfNodes(n).ChildNodes
'проверяем имена дочерних элементов
Select Case objNode.BaseName
'если есть элемент "DomainName" -
Case "DomainName"
'присваиваем переменной DomainName значение этого элемента
DomainName = objNode.Text
'если есть элемент "Data" -
Case "Data"
'присваиваем переменной Parameter значение дочернего элемента. Вопрос - чьего дочернего? т.е., кто родитель - "Data" ? правильно?
' и что в данном случае означает "ChildNodes(0)"? - первый дочерний эл-нт от элемена "Data"?
Parameter = objNode.ChildNodes(0).Text
' тут что-то не совсем понятно что такое "objNode.ChildNodes(1).ChildNodes" ..(
For Each oNod In objNode.ChildNodes(1).ChildNodes
'дальше все понятно..
Select Case oNod.BaseName
Case "Cy"
Cy = oNod.Text
Case "Yaca"
Yaca = oNod.Text
Case "YaBarMirrow"
YaBarMirrow = oNod.Text
End Select
Next
End Select
Next
Next
Прикладываю реальный XML, который пытаюсь разобрать. Еще раз, спасибо за помощь!
Странно вы как-то понимаете XPath. У вас же дочерними для DomainData являются только DomainName и Values - Data дочерний для Values. Если бы ваш xml был в допустимом виде, то его можно было напрямую импортировать на лист Excel. Во вложении пример, как добираться до интересующих вас DomainName и его дочерних сведений.
Андрей VG написал: Странно вы как-то понимаете XPath. У вас же дочерними для DomainData являются только DomainName и Values - Data дочерний для Values.
Так я так и понимаю.. Не понял, что Вас навело на обратные выводы. Если мои комментарии к коду уважаемого Doober, то мне сам код не совсем понятен - потому и написал как понял код (может где-то неверно выразился - в первые "в бою" сталкиваюсь с XML - учусь на ходу у гугла..)..
Цитата
Андрей VG написал: Если бы ваш xml был в допустимом виде, то его можно было напрямую импортировать на лист Excel.
Это я тоже уже понял, но, к сожалению, именно такой XML приходит с сервера..
Цитата
Андрей VG написал: Во вложении пример, как добираться до интересующих вас DomainName и его дочерних сведений.
Спасибо большое за пример! Выглядит понятным, но проверить не получается - он ничего не выдает (табличку на первом листе видел - я так понимаю, таким должен быть результат). Проверил макрос построчно - он после строки "For Each dData in dDataList" переходит на завершение макроса.. Поставил в предыдущей строке "MsgBox dDataList.Length" - получил сообщение "0". Файл XML перед выполнением макроса положил в папку с xmlparse.xls.
Так Сергей же писал в блокноте без отладки так вот и получилось А если более серьёзно. То лучше более строго подходить к путям узлов документа xml. Ваш файл получился сбойным из-за того, что вы текст в формате utf-8 сохранили в формате ANSI. Если пересохранить обратно, то будет всё хорошо. В архиве такой пересохранённый xml-файл (должен лежать в той же папке, что xlsb-файл). И файл кода с более строгим подходом к отбору узлов xml. В xlsb-файле результат импорта xml средствами Excel.
Ошибся немного в блокноте.единичку не отнял В вашем файле не хватает тега <?xml Если вы получаете xml документ так Set xmlDoc = HTTP.responseXML,то отработает правильно Результат
Sub DDD()
Dim xmlDoc
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
xmlDoc.async = False
xmlDoc.validateOnParse = False
strFilePath = "C:\Zapros_XML.xml"
xmlDoc.Load (strFilePath)
xmlDoc.setProperty "SelectionLanguage", "XPath"
XPath = "//DomainData"
Set objListOfNodes = xmlDoc.SelectNodes(XPath)
For n = 0 To objListOfNodes.Length - 1
For Each objNode In objListOfNodes(n).ChildNodes
Select Case objNode.BaseName
Case "DomainName"
DomainName = objNode.Text
Cells(n + 1, 1) = DomainName
Case "Values"
For Each oNod In objNode.ChildNodes(0).ChildNodes
Select Case oNod.BaseName
Case "Parameter"
Parameter = oNod.Text
Cells(n + 1, 2) = Parameter
Case "Value"
For Each x In oNod.ChildNodes
Select Case x.BaseName
Case "Cy"
Cy = x.Text
Cells(n + 1, 3) = Cy
Case "Yaca"
Yaca = x.Text
Cells(n + 1, 4) = Yaca
Case "YaBarMirrow"
YaBarMirrow = x.Text
Cells(n + 1, 5) = YaBarMirrow
End Select
Next
End Select
Next
End Select
Next
Next
End Sub