Параллельное обсуждение - http://www.cyberforum.ru/vba/thread1808717.html Я редко что-то спрашиваю на форумах - всегда стараюсь сам разбираться. Но мой опыт показывает, что обсуждая тему в 2-х форумах - обычно получаются как минимум разные подходы в решении + если находится какое-то решение на одном форуме - я всегда тут же его показываю на втором как раз для того чтобы те люди, которые помогают решить вопрос не тратили свое время зря. Мне кажется, в этом ничего плохого нет, а только плюсы для всех. Сам иногда кому-то помогаю если знаю решение, но обычно, к сожалению, просто физически не хватает времени.. - 2 ненормированных работы максимально забирают время, а когда-то еще и семье и детям надо уделять внимание..
Jungl,спасибо! Считываются файлы отлично! Только выборка не происходит из списка вариантов. На сколько я понимаю, Вы каким-то образом учитываете наличие тегов, типа "<p>" - это не совсем то, потому что конструкции могут быть где угодно, например, может быть такое
Код
"<div style="text-align:{center|left|right};"><a style="font-size:{14|13|12|10|9}px;color:{blue|grey|#29292b};" href="{mysite.ru|my1site.ru|sites{1|2|3|4|5}.ru}">{Посмотреть погоду|А гляньте ка сюда|Смотрите что у нас|Здесь отлично}</a></div>"
или
Код
"<title>{Какие мы {классные|хорошие}|Заходите к нам на огонек}!</title>"
. Как то так. Плюс, мы должны больше ничего не трогать и на выходе должна получиться html-страница только уже с конкретными случайными значениями. Прикрепил оригинал и вариант конечного файла.
Jungl,вот кстати на другом форуме по поводу кодировки открываемого файла подсказали:
Код
Dim objStream, strData
Set objStream = CreateObject("ADODB.Stream")
objStream.CharSet = "utf-8"
objStream.Open
objStream.LoadFromFile("c:\test\123.html")
strData = objStream.ReadText()
Вот, поменял в Вашем макросе - теперь с кодировкой все нормально, только с выбором слов пока непонятно - я уже раз 5 пробовал разобраться с рег.выражениями все никак не получается..((
Jungl,спасибо за помощь! Но по ходу что-то не так + с кодировкой по ходу такие же проблемы, с которыми и я сталкивался. Вот прикладываю файл - посмотрите что получается.
Всем доброго вечера! Не смог кратко полностью описать в заголовке вопрос, но как бы основную проблему написал. Теперь подробнее. На днях столкнулся с новой задачей и никак не могу ее до конца решить. Суть: Найти в файле "html" все конструкции типа спинтакс, например, "{Доброго дня|Здравствуйте|Привет}, {уважаемый|дорогой} Петр!", случайным образом выбрать один вариант и заменить им набор. Т.е., в результате должно получиться: - Доброго дня, уважаемыйПетр! - Здравствуйте, дорогой Петр! - Привет, уважаемый Петр! - и т.д.
Возникшие вопросы: 1. Как лучше считывать данные из файла "html" в кодировке UTF-8 без BOM? Много всего перелопатил - получилось только импортом на лист (переделал из макрорекордера):
Код
Sub loadhtml()
Dim wb As Workbook
Dim shM As Worksheet
Set wb = ActiveWorkbook
Set shM = wb.Sheets("Лист2")
sFiles = "c:\test\1.html"
With shM.QueryTables.Add(Connection:= _
"TEXT;" & sFiles, Destination:= _
Range("$A$1"))
.AdjustColumnWidth = False
.TextFilePlatform = 65001
.Refresh BackgroundQuery:=False
End With
End Sub
Проблема этого решения, что я не знаю как искать конструкции "{||}" в случае, если начало конструкции в одной строке, а конец в другой. Плюс, мне кажеться можно как-то обработать текст не записывая на лист, и соответственно будет работать быстрее.
2. Поиск конструкции "{||}" С учетом п.1, ищу построчно:
Код
Sub spintaks()
Dim wb As Workbook
Dim shM As Worksheet
Dim er& 'последняя строка
Dim arrTemp 'массив синонимов
Dim b& 'позиция искомого символа в строке, в нашем случае - "{"
Dim s$ 'конструкция типа "{||||}"
Dim a$ 'переменная для списка элементов массива
Dim poz As Integer 'позиция случайно выбранного значения
Dim wordi$ 'случайно выбранное значение (синоним) из массива
Set wb = ActiveWorkbook
Set shM = wb.Sheets("Лист3")
er = shM.Cells(shM.Rows.Count, 1).End(xlUp).Row
For i = 1 To er
b = InStr(1, shM.Cells(i, 1).value, "{")
Do While b <> 0
stri = shM.Cells(i, 1).value
s = Mid(stri, InStr(1, stri, "{"), Len(stri) - InStr(1, stri, "{") - (Len(stri) - InStr(1, stri, "}") - 1))
a = Replace(Replace(s, "}", ""), "{", "")
arrTemp = Split(a, "|")
Randomize
poz = Rnd * UBound(arrTemp)
wordi = arrTemp(poz)
shM.Cells(i, 1).value = Replace(shM.Cells(i, 1).value, s, wordi)
b = InStr(1, shM.Cells(i, 1).value, "{")
Loop
Next i
End Sub
Вопросы: -Как обрабатывать если начало конструкции в одной строке, а конец в другой (вполне может быть что даже не в следующей, а через одну или две)? -Никак не придумаю как обрабатывать случаи, когда есть вложенные конструкции, например, "{Сегодня {отличный|хороший|прекрасный} день!|Как {дела|поживаете}}."
3. Сохранение полученного текста в формате "html" в кодировке UTF-8 без BOM. Решил таким образом:
Код
Sub savehtm()
Dim wb As Workbook
Dim shM As Worksheet
Dim er& 'последняя строка
Dim mypath$ 'путь сохранения файла
Set wb = ActiveWorkbook
Set shM = wb.Sheets("Лист3")
mypath = "c:\test\1.html"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set outFile = FSO.CreateTextFile(mypath)
er = shM.Cells(shM.Rows.Count, 1).End(xlUp).Row
For i = 1 To er
outFile.WriteLine shM.Cells(i, 1).value
Next i
outFile.Close
ss = LoadTextFromTextFile(mypath)
sss = SaveTextToFile(ss, mypath, "utf-8noBOM")
End Sub
Функции "LoadTextFromTextFile" и "SaveTextToFile" нашел где-то на просторах интернета пару лет назад - спасибо автору - часто выручают:
Скрытый текст
Function SaveTextToFile(ByVal txt$, ByVal Filename$, Optional ByVal encoding$ = "windows-1251") As Boolean ' функция сохраняет текст txt в кодировке Charset$ в файл filename$ On Error Resume Next: Err.Clear Select Case encoding$
Case "windows-1251", "", "ansi" Set FSO = CreateObject("scripting.filesystemobject") Set ts = FSO.CreateTextFile(Filename, True) ts.Write txt: ts.Close Set ts = Nothing: Set FSO = Nothing
Case "utf-16", "utf-16LE" Set FSO = CreateObject("scripting.filesystemobject") Set ts = FSO.CreateTextFile(Filename, True, True) ts.Write txt: ts.Close Set ts = Nothing: Set FSO = Nothing
Case "utf-8noBOM" With CreateObject("ADODB.Stream") .Type = 2: .Charset = "utf-8": .Open .WriteText txt$
Set binaryStream = CreateObject("ADODB.Stream") binaryStream.Type = 1: binaryStream.Mode = 3: binaryStream.Open .Position = 3: .CopyTo binaryStream 'Skip BOM bytes .flush: .Close binaryStream.SaveToFile Filename$, 2 binaryStream.Close End With
Case Else With CreateObject("ADODB.Stream") .Type = 2: .Charset = encoding$: .Open .WriteText txt$ .SaveToFile Filename$, 2 ' сохраняем файл в заданной кодировке .Close End With End Select SaveTextToFile = Err = 0: DoEvents End Function Function LoadTextFromTextFile(ByVal Filename$, Optional ByVal encoding$) As String ' функция загружает текст в кодировке Charset$ из файла filename$ On Error Resume Next: Dim txt$ If Trim(encoding$) = "" Then encoding$ = "windows-1251" With CreateObject("ADODB.Stream") .Type = 2: If Len(encoding$) Then .Charset = encoding$ .Open .LoadFromFile Filename$ ' загружаем данные из файла LoadTextFromTextFile = .ReadText ' считываем текст файла .Close End With End Function
Т.о., повторю вопросы: 1. Как лучше считывать данные из файла "html" в кодировке UTF-8 без BOM? 2. Как обрабатывать если начало конструкции в одной строке, а конец в другой (вполне может быть что даже не в следующей, а через одну или две)? 3. Никак не придумаю как обрабатывать случаи, когда есть вложенные конструкции, например, "{Сегодня {отличный|хороший|прекрасный} день!|Как {дела|поживаете}}." Помогите пож-та. Вродь пока все, извините за большое количество текста..
Андрей 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, если в нем больше одного элемента "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, который пытаюсь разобрать. Еще раз, спасибо за помощь!
Здравствуйте, уважаемый, Игорь! И еще раз, здравствуйте, уважаемый 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? Заранее, спасибо.
Здравствуйте, уважаемые форумчане. Я в 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