Sub XHR_КСП_Здоровье()
Dim XMLHTTP As Object
Dim txt, Txt1, Txt0, URL, Cookie1, token As String
Dim dlina, status1 As Integer
URL = "https://fos.rshbins-life.ru/efrapi/auth/v1/session"
Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
With XMLHTTP
.Open "GET", URL, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko"
.send
Debug.Print .Status; .statusText; " GET session"
'Debug.Print .getResponseHeader("Set-Cookie")
'Cookie1 = Left(XMLHTTP.getResponseHeader("Set-Cookie"), dlina - 25)
'Debug.Print .getAllResponseHeaders()
token = XMLHTTP.getResponseHeader("x-token") ' получил токен зачем он?
Debug.Print token
Debug.Print .responseText
URL = "https://fos.rshb-ins.ru/efrapi/auth/v1/captcha"
.Open "GET", URL, False
.setRequestHeader "x-token", token
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko"
.send
Debug.Print .Status; .statusText; " GET captcha"
Debug.Print .getAllResponseHeaders()
Debug.Print .responseText ' вижу капчу она всегда равна сaptchaUuid :null и при работе через браузер и через макрос
URL = "https://fos.rshb-ins.ru/efrapi/auth/v1/login"
.Open "POST", URL, False ' "логин", "пароль" если так ввести ошибка 400
.setRequestHeader "x-token", token
.setRequestHeader "Content-type", "application/json" 'без типа ошибка 415
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko"
.send "{""login"":""*********"",""passwd"":""********"",""captchaUuid"":null}"
Debug.Print .Status; .statusText; " POST Залогин"
Debug.Print .responseText
Debug.Print .getAllResponseHeaders()
End With
End Sub
Финальный код который работает! Ура. Всем спасибо! Если есть идеи по оптимизации готов услышать) Как , зачем и почему использовать функции к примеру не знаю
Код
Sub СМС_версия_2()
Dim XMLHTTP As Object
Dim txt, Txt1, Txt0, URL, Cookie1 As String
Dim dlina, status1 As Integer
Dim ADOStream As Object
Dim FolderSave$, FileName$
'Папка для сохранения файла
FolderSave = "C:\Users\***********"
URL = "https://fos.smedservice.ru/efrapi/auth/v1/login"
Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
With XMLHTTP
.Open "POST", URL, False
.setRequestHeader "Content-type", "application/json"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.77 YaBrowser/20.11.0.821 Yowser/2.5 Safari/537.36"
.send "{""login"":""******"",""passwd"":""********""}"
Debug.Print .Status; .statusText; " POST Залогин"
dlina = Len(XMLHTTP.getResponseHeader("Set-Cookie"))
Cookie1 = Left(XMLHTTP.getResponseHeader("Set-Cookie"), dlina - 25)
'Debug.Print Cookie1
URL = "https://fos.smedservice.ru/efrapi/insurance-service/v2/contracts/extract/?startDate=01.02.2021&endDate=07.02.2021&kind="
.Open "GET", URL, False
.setRequestHeader "Cookie", Cookie1
.setRequestHeader "Content-type", "application/json"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.77 YaBrowser/20.11.0.821 Yowser/2.5 Safari/537.36"
.send
Debug.Print .Status; .statusText; " GET период для выгрузки"
'Debug.Print XMLHTTP.getAllResponseHeaders()
dlina = Len(XMLHTTP.responseText)
txt = Right(XMLHTTP.responseText, dlina - 9)
dlina = Len(txt)
Txt0 = Left(txt, dlina - 2) & "/content/" '/content/
Txt1 = Left(txt, dlina - 2) & "/content"
txt = Left(txt, dlina - 2) & "/status"
URL = "https://fos.smedservice.ru/efrapi/insurance-service/v2/contracts/extract/" & txt
.Open "GET", URL, False
.setRequestHeader "Cookie", Cookie1
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.77 YaBrowser/20.11.0.821 Yowser/2.5 Safari/537.36"
.send
Debug.Print .Status; .statusText; " GET Формирование файла"
Debug.Print .responseText
Do
URL = "https://fos.smedservice.ru/efrapi/insurance-service/v2/contracts/extract/" & txt
.Open "GET", URL, False
.setRequestHeader "Cookie", Cookie1
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.77 YaBrowser/20.11.0.821 Yowser/2.5 Safari/537.36"
.send
Debug.Print .Status; .statusText; " GET Формирование файла"
Debug.Print .responseText
Application.Wait (Now + TimeValue("0:00:04"))
'status1 = MsgBox("Продолжаем?", vbYesNo)
'If status1 = 7 Then
' Exit Do
'End If
Loop While .responseText = "{""status"":""CREATING""}"
Debug.Print .responseText
URL = "https://fos.smedservice.ru/efrapi/insurance-service/v2/contracts/extract/" & Txt1
.Open "GET", URL, False
.setRequestHeader "Cookie", Cookie1
.setRequestHeader "Content-Type", "application/octet-stream"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.77 YaBrowser/20.11.0.821 Yowser/2.5 Safari/537.36"
.send
Debug.Print .Status; .statusText; " GET content"
End With
'Получаем имя файла с расширение "Отчёт по продажам с 2021-02-06 по 2021-02-06.xlsx"
FileName = CreateObject("Scripting.FileSystemObject").GetFileName(URL) & ".xlsx"
If XMLHTTP.Status = 200 Then
Set ADOStream = CreateObject("ADODB.Stream")
ADOStream.Type = 1 'указываем тип данных, содержащихся в потоке. Бинарный.
ADOStream.Open 'Открывает поток для работы потоков двоичных или текстовых данных
ADOStream.Write XMLHTTP.responseBody 'Записываем в виде массива байтов. Используется при закачке бинарного файла
ADOStream.SaveToFile FolderSave & FileName, 2 'Сохраняем файл в указанную папку
'1 не перезаписывать файл
'2 перезаписать файл
ADOStream.Close 'Закрывает открытый объект и все зависимые объекты
Set ADOStream = Nothing
MsgBox "Файл загружен", vbInformation, "Ок"
Else
MsgBox "Не удаётся скачать файл", vbExclamation, "Опаньки"
End If
Set XMLHTTP = Nothing
End Sub
Oleg Boyaroff написал: Покажите ваши потуги, если они конечно изменились с предыдущей темы.
Код
Sub СМС()
Dim XMLHTTP, XMLDoc As Object
Dim txt, Txt1, Txt0, Url As String
Dim dlina As Integer
Url = "https://fos.smedservice.ru/efrapi/auth/v1/login"
Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
Set XMLDoc = CreateObject("MSXML2.DOMDocument")'не использую т к хз что это
With XMLHTTP
.Open "POST", Url, False
.setRequestHeader "Content-type", "application/json"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.77 YaBrowser/20.11.0.821 Yowser/2.5 Safari/537.36"
.send "{""login"":""******"",""passwd"":""*******""}"
Debug.Print .Status; .statusText
Url = "https://fos.smedservice.ru/efrapi/insurance-service/v2/contracts/extract/?startDate=06.02.2021&endDate=06.02.2021&kind="
.Open "GET", Url, False
.setRequestHeader "Content-type", "application/json"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.77 YaBrowser/20.11.0.821 Yowser/2.5 Safari/537.36"
.send
Debug.Print .Status; .statusText
dlina = Len(XMLHTTP.responseText)'Обрезаю кавычки, скобки и лишний текст
txt = Right(XMLHTTP.responseText, dlina - 9)'Обрезаю кавычки, скобки и лишний текст
dlina = Len(txt)'Обрезаю кавычки, скобки и лишний текст
Txt0 = Left(txt, dlina - 2) & "/content/Отчёт по продажам с 2021-02-06 по 2021-02-06.xlsx" '/content/
Txt1 = Left(txt, dlina - 2) & "/content"'не получается склеить "адресс ссылки"&переменная&"и снова текст" поэтому сделал так
txt = Left(txt, dlina - 2) & "/status"'не получается склеить "адресс ссылки"&переменная&"и снова текст" поэтому сделал так
Url = "https://fos.smedservice.ru/efrapi/insurance-service/v2/contracts/extract/" & txt
.Open "GET", Url, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.77 YaBrowser/20.11.0.821 Yowser/2.5 Safari/537.36"
.send
Debug.Print .Status; .statusText
Url = "https://fos.smedservice.ru/efrapi/insurance-service/v2/contracts/extract/" & Txt1
.Open "GET", Url, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.77 YaBrowser/20.11.0.821 Yowser/2.5 Safari/537.36"
.send
Debug.Print .Status; .statusText
'все что ниже попытки скачать методом тыка и понять что не так. Мне сказали что нужна ссылка на файл который я скачиваю.
'Но файл то формируется каждый раз, поэтому статичной ссылки нет, а вот динамическую ссылку я не вижу через разработчика в браузере
txt = Txt0 & Replace(.getResponseHeader("Content-Disposition"), "attachment; filename=", "")'Вычленяю имя файла хотя имя файла всего одно и тоже, меняется только дата в названии.
Url = "https://fos.smedservice.ru/efrapi/insurance-service/v2/contracts/extract/" & Txt0
.Open "GET", Url, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.77 YaBrowser/20.11.0.821 Yowser/2.5 Safari/537.36"
.send
Debug.Print Url
'Debug.Print txt
Debug.Print .Status; .statusText
'Debug.Print .responseText
End With
End Sub
Если честно не понял что конкретно использовать. И подходит ли это ко мне. Т. к. исходный текст страницы это не файл xlsx который нужно скачать. респонсТекст пустой если что..
Добрый день! делаю гет запрос к ссылке контент, статус 200, вижу в заголовке отчета Content-Disposition c "именем файла.xlsx" который я хочу скачать. Если работать через браузер как пользователь то это появляется на этапе автоматического скачивания файла браузера Яндекс либо на этапе выбора куда сохранить файл в IE.
Что прописать в коде после .send ? Чую что нужен response, что чтобы забрать ответ от сервера в папку на рабочий стол к примеру. Хелп! =)
Доступа в выходные к удаленке нет, завтра дополню пост кодом.
Привет! Задача автоматизировать ежедневную рутину: захожу на сайт, авторизовываюсь, захожу во вкладку отчеты, прописываю период, нажимаю выгрузить, жду, сохраняю файл. И так 8 разных сайтов. В теме XMLHttpRequest первый день. Другие варианты Sendkeys, Shell, не рассматриваю, мало опыта, кажется не надежным, не везде работает.
И так вот код.
Код
Sub Тест()
Dim xmlhtp As Object
Set xmlhtp = CreateObject("MSXML2.XMLHTTP")
With xmlhtp
.Open "POST", "https://fos.rshb-ins.ru/efrapi/auth/v1/login", False
.setRequestHeader "Content-type", "application/json; charset=UTF-8"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.77 YaBrowser/20.11.0.821 Yowser/2.5 Safari/537.36"
.send "{""login"":""*****"",""passwd"":""******"",""captchaUuid"":null}"
Debug.Print .Status; .statusText
End With
End Sub
Пароль ввожу верный. не знаю на счет двойных кавычек но не ругается. Ошибки были 400, 415, 500 Также нет понимания как действовать после, т.к. нужно будет переходить на другую вкладку, выбирать вид отчета, дату. По идее для всего этого нужен будет только POST. А что будет с файлом и куда он сохранится и помыслить не могу