Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
VBA Excel выгрузка больших файлов, Не получается выгрузить большие файлы Msxml2.ServerXMLHTTP.6.0
 
Цитата
написал:
Проще использовать специализированные средства, например  curl  (входит в последние версии Windows, иначе можно установить с сайта разработчика).
Владимир, спасибо огромное. Полдня провозился, но настроил загрузчик.

Теперь планирую разобраться с получением x-csrf-token и JSESSIONID через curl
VBA Excel выгрузка больших файлов, Не получается выгрузить большие файлы Msxml2.ServerXMLHTTP.6.0
 
Цитата
написал:
Проще использовать специализированные средства, например  curl  (входит в последние версии Windows, иначе можно установить с сайта разработчика).

Спасибо за ответ.

Пошел в этом направлении, но никак не могу написать корректный запрос в cUrl.

У меня есть минимальный запрос через MSXML2.ServerXMLHTTP60, который работает для небольших файлов:
Код
Sub test ()
   Dim httpObject1 As MSXML2.ServerXMLHTTP60    'Object
   Set httpObject1 = New MSXML2.ServerXMLHTTP60
   httpObject1.Open "GET", "https://...../attachment/allByType?attachmentId=841817&documentTypeId=19", False
   httpObject1.setRequestHeader "cookie", "JSESSIONID=C2DCA44E546D620399055A0912C75085;"
   httpObject1.sEnd
   Set ADOStream = CreateObject("ADODB.Stream")
   ADOStream.Type = 1: ADOStream.Open
   ADOStream.Write httpObject1.responseBody
   ADOStream.SaveToFile "C:\_Project_\_tmp_\1\1\dd.zip", 1
   ADOStream.Close:
End sub

Поскольку у меня есть еще элементы авторизации, то пробую то же реализовать через командную строку (для начала) что бы понять как работает данная утилита. К сожалению у меня ничего не выходит, явно где-то хромает синтаксис.
Код
curl -b “JSESSIONID=C2DCA44E546D620399055A0912C75085;” https://...../attachment/allByType -d “attachmentId=841817;documentTypeId=19” -o “C:\_Project_\_tmp_\1\1\dd.zip”
VBA Excel выгрузка больших файлов, Не получается выгрузить большие файлы Msxml2.ServerXMLHTTP.6.0
 
Добрый день. Столкнулся с проблемой. Написал скрипт выгрузки  и сохранения файлов с внутреннего сайта компании. Структура кода следующая:
Код
Public Function GetResult_Get_Save(sUrl As String, sFileName As String)
   Dim httpObject1 As New MSXML2.ServerXMLHTTP60   'Object
   Set httpObject1 = CreateObject("Msxml2.ServerXMLHTTP.6.0")
Set httpObject = Nothing

    httpObject1.Open "GET", sUrl, False

httpObject1.setRequestHeader "accept", "*/*" '"text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3;q=0.9"
httpObject1.setRequestHeader "accept-Encoding", "gzip , deflate, br"
httpObject1.setRequestHeader "accept-language", "ru-RU,ru;q=0.9,en-US;q=0.8,en;q=0.7"
httpObject1.setRequestHeader "cache-Control", "no-cache"
httpObject1.setRequestHeader "cookie", ".........."
httpObject1.setRequestHeader "pragma", "no-cache"
httpObject1.setRequestHeader "referer", "...."
httpObject1.setRequestHeader "sec-ch-ua", """ Not A;Brand"";v=""99"", ""Chromium"";v=""98"", ""Google Chrome"";v=""98"""
httpObject1.setRequestHeader "Sec-ch-ua-mobile", "?0" '"Print 0"
httpObject1.setRequestHeader "sec-ch-ua-platform", """Windows"""
httpObject1.setRequestHeader "Sec-fetch-dest", "document"
httpObject1.setRequestHeader "Sec-fetch-Mode", "navigate"
httpObject1.setRequestHeader "Sec-fetch-site", "same-origin"
httpObject1.setRequestHeader "Sec-fetch-user", "?1" ' "Print 1"
httpObject1.setRequestHeader "upgrade-insecure-requests", "1"
httpObject1.setRequestHeader "user-agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/98.0.4758.102 Safari/537.36"
  httpObject1.sEnd
    'httpObject1.waitForResponse (100)
    
        Set ADOStream = CreateObject("ADODB.Stream")
        Debug.Print httpObject1.responseText
        ADOStream.Type = 1: ADOStream.Open
        ADOStream.Write httpObject1.responseBody
 
        ADOStream.SaveToFile "C:\_Project_\_tmp_\1\1\" & sFileName, 1
        ADOStream.Close:
        Set ADOStream = Nothing
        Set httpObject1 = Nothing
sTest = "Ok"
    
End Function

В целом код работает, но есть ограничение по размеру файла. Файлы грузятся размером менее 80Мб. У меня же есть необходимость грузить файлы без ограничения по размеру. Я не исключаю, что эта проблема не совсем Excel, а взаимодействия с конкретной информсистемой, откуда я качаю информацию. Кто что может посоветовать? Что можно попробовать? и куда посмотреть?

Помимо прочего пробовал WinHttp.WinHttpRequest.5.1 и MSXML2.XMLHTTP. Для первого ситуация та же, для второго не получается загрузить файл.

В дополнение, Ошибка возникает на Send. Код ошибки 2147012744 "Сервер вернул недопустимый или нераспознанный ответ". Ошибка появляется на одном и том же закачиваемом файле через разное время...иногда это 3 мин, иногда 6 мин. Chrom загружает файлы существенно быстрее чем мой код.
Изменено: ANDREY - 16.08.2022 16:43:41
Получение параметров Cookies
 
Цитата
Еще раз попытался пойти по твоему алгоритму, уткнулся в отсутствие Location в возвращаемом ответе

Цитата
написал:
' если есть заголовок Location - выполняем редирект


Код
Sub sGetCoockes()
    Dim sGetResult As Variant
    Dim httpObject As Object
    Dim sCookiesPath$, oCookies As Object, oFSO As Object, oFolder As Object, oFile
    Dim sContent As String, aCook() As String, i As Long, aItems, aCookies()
    
    Set httpObject = CreateObject("WinHttp.WinHttpRequest.5.1")
    httpObject.Open "GET", "https://kad.arbitr.ru/", False
    httpObject.Option(WinHttpRequestOption_EnableRedirects) = False
    httpObject.setRequestHeader "Host", "kad.arbitr.ru"
   ' httpObject.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/85.0.4183.102 Safari/537.36"
    httpObject.send

    sGetResult = httpObject.getAllResponseHeaders
     Debug.Print sGetResult
    Set httpObject = Nothing
End Sub


Ответ:

Код
[/CODE][P][/P]
[P][/P]
[P][/P]
[CODE]Cache-Control: no-cache, no-store, must-revalidate
Date: Tue, 15 Feb 2022 14:41:25 GMT
Pragma: no-cache
Content-Length: 4298
Content-Type: text/html; charset=utf-8
Set-Cookie: ASP.NET_SessionId=j1bhhlskxhwesanq15uikgcn; path=/; HttpOnly
Set-Cookie: ASP.NET_SessionId=j1bhhlskxhwesanq15uikgcn; path=/; HttpOnly
Set-Cookie: CUID=7cbb50c8-7d1b-4620-b880-b55adbfde177:egJsawQDPfJ+UtJCXEsarg==; domain=.arbitr.ru; expires=Sun, 15-Feb-2032 14:41:25 GMT; path=/; HttpOnly
Set-Cookie: .ASPXAUTH=fixcookie; domain=.kad.arbitr.ru; path=/; expires=Tue, 02-Apr-2012 14:12:08 GMT; HttpOnly
Set-Cookie: SERVERID=KAD-APP3; path=/
content-security-policy: upgrade-insecure-requests
Изменено: ANDREY - 15.02.2022 17:44:57
Получение параметров Cookies
 
Цитата
написал: надо открывать страницу в режиме Инкогнито
Искал и в режиме Инкогнито, и удалял куки прям перед перехода на страницу. Отслеживал все стоки в консоли. Использовал поиск в консоли. Соответствующие куки находит только Request Headers. Не исключаю, что я что то делал не так, но я затратил на это достаточно много времени.

Цитата
это алгоритм, для понимания, что примерно нужно делать
Да я в принципе понял, что это алгоритм. Попробую еще раз завтра с утра переложить в код. Может выйдет.

Цитата
написал: это же самый простой вариант, при запуске открыть браузер, ввести капчу если она есть, считать куки,  закрыть браузер, и потом выполнять запросы
Получить куки я могу и через консоль, скопировав их из Request Headers. Это нужно делать даже не так часто, данные куки живут около недели. Вопрос в автоматизации получения куков.
Неправильно отображаются отрезки на диаграмме
 
Как я понимаю, в колонке G и H номера точек, которые соединены. Данные номера явно вычисляются программно и у вас этой программы нет?
Получение параметров Cookies
 
Игорь, спасибо большое за развернутый ответ. Я все воскресенье вчера бился. Но не победил:

Цитата
написал:
При загрузке главной страницы браузер выполняет много запросов
Да, я тоже это предполагал и пробежался по всему перечню на предмет Set-cookies. Ни в одном Response Headers не устанавливаются искомые Cookies.


Цитата
написал:
Чтобы это учесть, надо заметно усложнять функцию загрузки страницы:

Я не смог переложить предложенный код в VBA excel. Не распознаются функции GetRedirectLocation,SaveCookiesFromResponseHeaders и др. Не понимаю как их переложить. Может тут нужно какую библиотеку подкулючить

Цитата
написал:
открыть страницу в браузере IE
открыть страницу в браузере IE не вариант, видимо разработчики предусмотрели этот ход, и доступ к странице из IE защищен капчей.
Автоматическое суммирование ячеек относительно текущей даты
 
Код
=СУММПРОИЗВ(DN11:EH11;1*(DN4:EH4<=СЕГОДНЯ()))
Получение параметров Cookies
 
При парсинге сайта арбитрточкару не могу решить следующую задачу. При запросе Post в RequestHeader используется Cookies. Без него не получается получить правильны ответ. Эти Cookie имеют время жизни, после чего требуется их обновить.


Через запрос GET  и последующее .getAllResponseHeaders:
Код
Sub sGetCoockes()
    Dim sGetResult As Variant
    Dim httpObject As Object
    Set httpObject = CreateObject("Msxml2.ServerXMLHTTP.6.0")
    httpObject.Open "GET", "https://kad.arbitr.ru/", False
    httpObject.setRequestHeader "Host", "kad.arbitr.ru"
    httpObject.setRequestHeader "Content-type", "application/xml"
    httpObject.send
    sGetResult = httpObject.getAllResponseHeaders
    Debug.Print sGetResult
    Set httpObject = Nothing
End Sub
получается ответ, который содержит только два компонента (ASP.NET_SessionId и CUID):
Код
Pragma: no-cache
Content-Length: 4298
Content-Type: text/html; charset=utf-8
Set-Cookie: ASP.NET_SessionId=onva11syoaf5yei0dtdb0mps; path=/; HttpOnly
Set-Cookie: ASP.NET_SessionId=onva11syoaf5yei0dtdb0mps; path=/; HttpOnly
Set-Cookie: CUID=f6e62d6a-38a2-4421-8da5-38ef0bc1b04c:dLSyS9fefhpkRtWAe2Sfyw==; domain=.arbitr.ru; expires=Wed, 11-Feb-2032 11:51:18 GMT; path=/; HttpOnly
Set-Cookie: .ASPXAUTH=fixcookie; domain=.kad.arbitr.ru; path=/; expires=Tue, 02-Apr-2012 14:12:08 GMT; HttpOnly
content-security-policy: upgrade-insecure-requests

Как я могу получить полный пакет Cookies (в том числе pr_fp    wasm   rcid) для формирования правильного запроса POST ?

Поиск по трем условиям в массиве (горизонтальный и вертикальный)
 
Цитата
=СУММПРОИЗВ(B4:G13;(B2:G2="Март")*(B3:G3="Магазин2")*(A4:A13="Статья5"))
Вот эта формула суммирует корректно.
Поиск по трем условиям в массиве (горизонтальный и вертикальный)
 
Пришлось добавить техническую строку
Парсинг сайта arbitr VBA, Не получается получить правильный отклик от сайта
 
Цитата
написал:
Там предупреждение
Да, при первом заходе. При повторном обращении (с куками) сообщение не появляется.
Подстановка сумм в зависимости от диапазона времени и дат
 
Это же пересекающиеся диапазоны. По какому критерию выбирать? По времени отправления? Или и отправления и прибытия?

пн-чт 8.00-20.00
вск-чт 20.00-08.00
пт-вск 08.00-20.00
пт-сб    20.00-08.00

Можно воспользоваться вот такой формулой, но для меня не понятен алгоритм выбора типа суток. Если его однозначно прописать с выбором значения от 1 до 4 и проставить формулу в <>, то все должно получиться.
Код
=ВПР(C2;Лист2!A3:M7;1+<Выбор типа суток от 1 до 4>*ЕСЛИ(И(C3<ДАТА(ГОД(C3);5;12);C3>ДАТА(ГОД(C3);9;5));1;ЕСЛИ(И(C3<ДАТА(ГОД(C3);6;30);C3>ДАТА(ГОД(C3);6;10));3;2));0)
Удалить дату в конце текста, если она там есть.
 
Может так:
Код
=ЛЕВСИМВ(B4;ДЛСТР(B4)-9)
Парсинг сайта arbitr VBA, Не получается получить правильный отклик от сайта
 
Цитата
написал:
Есть возможность использовать в VBA-коде работу через Internet Explorer
Очевидно они (разработчики) это тоже знают и при запросе через IE появляется капча.
Парсинг сайта arbitr VBA, Не получается получить правильный отклик от сайта
 
Цитата
написал:
Set-Cookie: в httpObject.getAllResponseHeaders
При  GET запросе получаем набор как на картинке во вложении (аналогичные параметры и excel). Потом при отправлении запроса (в браузере) отправляется уже другой набор. Откуда взять нижние параметры я не понимаю.
Сохранение старого значения ячейки при событии листа Worksheet_Change
 
Цитата
написал:
переменная СтароеЗначение изначально будет пустой
Данная переменная перестает быть пустой при выделении или активации ячейки. Если в этой ячейке отсутствует значение, то значит предыдущее значение "". И это можно обработать.
Сохранение старого значения ячейки при событии листа Worksheet_Change
 
Может так?
Поиск предыдущего значения по виду дня (будни, пятницы, субботы, воскресенья)
 
Не очень понял задачу. В обоих описанных вариантах значение нужно за аналогичный день предыдущей недели. Пятница это 4 февраля. На этой странице добавил формулу поиска на странице Месяц значения за день - 7 дней.
Парсинг сайта arbitr VBA, Не получается получить правильный отклик от сайта
 
Мне никто этого еще не говорил. В моем понимании куки имеют срок действия, поэтому я их регулярно обновлял в своем Post запросе. Это не помогало. А каким образом с помощью GET запроса я смог бы обновлять кукуи? Есть откуда списать?
Копирование форматирования в рамках ячеек, не диапазона
 
Если задача сравнивать два значения в соседних значения и раскрашивать в зависимости от того, что из них больше, то можно так:
Парсинг сайта arbitr VBA, Не получается получить правильный отклик от сайта
 
Игорь, спасибо за ответ.
Цитата
можно, конечно, через программу Fiddler сравнить запрос из браузера IE и из макроса, — вдруг там будут какие-то отличия
для разбора я пользовался DevTools  в Chrome. Надеюсь разницы особо нет.
Цитата
написал:
макрос с поддержкой gzip будет непрост
А есть пример, ссылка на гдепочитать. Буду очень благодарен.
Парсинг сайта arbitr VBA, Не получается получить правильный отклик от сайта
 
Добрый день. Третий день мучаю проблему и никак не могу разобраться. Излазил много форумов, ответ найти не смог. Задача получить ответ с сайта ras arbitr ru. Код во вложении.

В ответ на запрос через браузер получаю JSON с 25 записями о делах. В результате запроса из VBA только 1 запись не связанную с передаваемыми параметрами.
Непонятны 2 вещи:
почему не учитываются мои параметры - payload?
почему даже при пустом запросе возвращается только одна строка?
Парсинг сайта arbitr VBA, Не получается получить правильный отклик от сайта
 
Добрый день. Третий день мучаю проблему и никак не могу разобраться.
Излазил много форумов, ответ найти не смог. Задача получить ответ с сайта ras arbitr ru.

Вот тот код, который написан:

Код
Sub arbitr()

 

Dim httpObject As Object

Dim
sGetResult As Variant

'Set
httpObject = CreateObject("MSXML2.XMLHTTP")

Set
httpObject = CreateObject("Msxml2.ServerXMLHTTP.6.0")

'Set
httpObject = CreateObject("WinHttp.WinHttpRequest.5.1")

 

httpObject.Open
"POST", "http://ras.arbitr.ru/Ras/Search", False

httpObject.setRequestHeader
"Host", "ras.arbitr.ru"

httpObject.setRequestHeader
"Connection", "keep-alive"

httpObject.setRequestHeader
"Content-Length", "201"

httpObject.setRequestHeader
"Accept", "application/json, text/javascript, */*"

httpObject.setRequestHeader
"X-Requested-With", "XMLHttpRequest"

httpObject.setRequestHeader
"User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64)
AppleWebKit/537.36 (KHTML, like Gecko) Chrome/85.0.4183.102 Safari/537.36"

httpObject.setRequestHeader
"Content-Type", "application/json" '; charset=utf-8"

httpObject.setRequestHeader
"Origin", "https://ras.arbitr.ru"

httpObject.setRequestHeader
"Sec-Fetch-Site", "same-Origin"

httpObject.setRequestHeader
"Sec-Fetch-Mode", "cors"

httpObject.setRequestHeader
"Sec-Fetch-Dest", "empty"

httpObject.setRequestHeader
"Referer", "https://ras.arbitr.ru/"

'httpObject.setRequestHeader
"Accept-Encoding", "gzip , deflate, br"

httpObject.setRequestHeader
"Accept-Language", "ru-RU,ru;q=0.9,en-US;q=0.8,en;q=0.7"

httpObject.setRequestHeader
"Cookie", _

"ASP.NET_SessionId=lfd20vhxrqz1y01towgyovgz;
CUID=c1d8de6b-b120-4c38-80c5-b00314807c75:pYVAtsY2lnncvav/Ih/t5w==; __utmz=14300007.1642747586.1.1.utmcsr=google|utmccn=(organic)|utmcmd=organic|utmctr=(not%20provided);
__utmc=14300007; _ga=GA1.2.855320026.1642747586; tmr_lvidTS=1642747788613;
tmr_lvid=38f17b338dbe5024194dc13ad97f1368; _ym_uid=1642747789708820668;
_ym_d=1642747789;
pr_fp=e96f3347f23da682373ee1c149eda3ce025ec93c053a947e4fec828b166330d3;
is_agree_privacy_policy=true;
.ASPXAUTH=48089F490BB8A2ADF54199E1042EC1EB883678393734D8693A96228A0BBF176B5A39E8B407FA2E2F444B93CD3C2DB2FA1FE0F54E362A35A783E4789F221799A3936B92980E96D06D668526AA05362ADF1D2F83A3C32FB6745242F302BC63B4B0BBCE45B5;
_gid=GA1.2.517942562.1643617454;
__utma=14300007.855320026.1642747586.1643093404.1643635736.4;
KadLVCards=%d0%9041-58578%2f2021; _fbp=fb.1.1643636579482.1085817934;
_ym_isad=2; tmr_detect=0%7C1643693617619;
rcid=839229d1-138c-4f49-8920-cbe70a95b100;
wasm=d1ed79c6d1cdb40f83ada9318c1cd9b0; tmr_reqNum=65; _gat=1"

payload1 =
"{""GroupByCase"":false,""Count"":25,""Page"":1,""Courts"":[""ASMO""],""DateFrom"":""2000-01-01T00:00:00"",""DateTo"":""2030-01-01T23:59:59"",""Sides"":[],""Judges"":[],""Cases"":[],""Text"":""""}"

Dim
payload() As Byte

payload =
StrConv(payload1, vbFromUnicode)

httpObject.Send
(payload)

sGetResult =
httpObject.responseText

Debug.Print
sGetResult

Set
httpObject = Nothing

 

End Sub

В ответ на запрос через браузер получаю JSON с 25 записями о делах. В ответ на запрос из Excel получаю не связанную с payload информацию.

Страницы: 1
Наверх