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

Страницы: 1
VBA скачать файл с сайта
 
Код
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
Изменено: Joker097 - 12.02.2021 13:21:33
VBA скачать файл с сайта
 
И снова я :)
почему у меня ошибка 500? Думаю что дело в куки, но в Response его нет нигде.

VBA скачать файл с сайта
 
Финальный код который работает! Ура. Всем спасибо!
Если есть идеи по оптимизации готов услышать) Как , зачем и почему использовать функции к примеру не знаю
Код
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
 
Изменено: Joker097 - 09.02.2021 18:44:39
VBA скачать файл с сайта
 
Цитата
Игорь написал:
Проблема с формированием ссылки на скачивание файла
200 OK POST Залогин
200 OK GET период для выгрузки
200 OK GET Формирование файла
200 OK GET content
404 Not Found GET с ссылкой URLEncode
https://fos.smedservice.ru/efrapi/insurance-service/v2/contracts/extract/53ff0c6b-87c9-4a48-befd-590b51d084ea/%D0%9E%D1%82%D1%87%D1%91%D1%82%20%D0%BF%D0%BE%2­0%D0%BF%D1%80%D0%BE%D0%B4%D0%B0%D0%B6%D0%B0%D0%BC%20%D1%81%2­02021-02-08%20%D0%BF%D0%BE%202021-02-08.xlsx
Ниже файл который качаю
Выше файл который качаю

ИЛИ

200 OK GET период для выгрузки
200 OK GET Формирование файла
200 OK GET content
404 Not Found GET с ссылкой URLEncode
https://fos.smedservice.ru/efrapi/insurance-service/v2/contracts/extract/27f9ccac-490f-4134-811b-78680ec3cd16/content/%D0%9E%D1%82%D1%87%D1%91%D1%82%20%D0%BF%D0%BE%20%D0%BF%D1%8­0%D0%BE%D0%B4%D0%B0%D0%B6%D0%B0%D0%BC%20%D1%81%202021-02-08%20%D0%BF%D0%BE%202021-02-08.xlsx
Ниже файл который качаю
Выше файл который качаю


Все равно ошибка 404.  Если ошибка 404 то это можно даже не делать?
Цитата
в данном случае (бинарный ответ) нужно использовать .responseBody (перекодируя через ADODB.Stream)
Пример кода:

Код
URL = "https://fos.smedservice.ru/efrapi/insurance-service/v2/contracts/extract/" & Txt1
    .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 content"
   

    'txt = URL_Encode(Replace(.getResponseHeader("Content-Disposition"), "attachment; filename=", ""))
    txt = URL_Encode("Отчёт по продажам с 2021-02-08 по 2021-02-08.xlsx")
    
    Txt0 = Txt0 & txt
          
    URL = "https://fos.smedservice.ru/efrapi/insurance-service/v2/contracts/extract/" & Txt0
   .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 с ссылкой URLEncode"
    
   Debug.Print URL
   Debug.Print " Ниже файл который качаю"
   Debug.Print .responseBody;
   Debug.Print " Выше файл который качаю"
   'Debug.Print XMLHTTP.getAllResponseHeaders()
   
    
   End With
Изменено: Joker097 - 08.02.2021 16:41:32
VBA скачать файл с сайта
 
Цитата
Oleg Boyaroff написал:
Не увидел заголовка octet-stream
Не знаю что это, хотя кажется где то видел, но через XMLHTTP.getAllResponseHeaders() просмотрел, не на одном этапе не увидел.
VBA скачать файл с сайта
 
Да куки есть. Знаю только что они нужны для идентификации меня на сайте. (вчера узнал) =)
VBA скачать файл с сайта
 
Цитата
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

Вот грубо говоря что я вижу.
в Immediate
200 OK
200 OK
200 OK
200 OK
https://fos.smedservice.ru/efrapi/insurance-service/v2/contracts/extract/e25e3cf8-3251-491d-8f2f-70b... по продажам с 2021-02-06 по 2021-02-06.xlsx
400 Bad Request
Изменено: Joker097 - 08.02.2021 12:58:36
VBA скачать файл с сайта
 
Если честно не понял что конкретно использовать. И подходит ли это ко мне. Т. к. исходный текст страницы это не файл xlsx который нужно скачать. респонсТекст пустой если что..

Разжуйте подробно)
VBA скачать файл с сайта
 
Добрый день! делаю гет запрос к ссылке контент, статус 200, вижу в заголовке отчета Content-Disposition c "именем файла.xlsx" который я хочу скачать. Если работать через браузер как пользователь то это появляется на этапе автоматического скачивания файла браузера Яндекс либо на этапе выбора куда сохранить файл в IE.

Что прописать в коде после .send ? Чую что нужен response, что чтобы забрать ответ от сервера в папку на рабочий стол к примеру. Хелп! =)


Доступа в выходные к удаленке нет, завтра дополню пост кодом.
VBA и запрос POST для авторизации на сайте Status 500
 
Получилось здесь, но! как я и предполагал простого GET мало, файл не сформировался и не сохранился никуда. Видимо после Send чего то еще не хватает.
Код
Sub СМС()

Dim xmlhtp As Object
Dim Txt$, Url$

Url = "https://fos.smedservice.ru/efrapi/auth/v1/login"

  Set xmlhtp = CreateObject("MSXML2.XMLHTTP")
  With xmlhtp
   .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=01.01.2021&endDate=29.01.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 "startDate=01.01.2021&endDate=29.01.2021&kind="
    Debug.Print .Status; .statusText
    
     
  End With

End Sub
Файл нужен в формате Excel
Изменено: Joker097 - 29.01.2021 21:00:26
VBA и запрос POST для авторизации на сайте Status 500
 
Привет! Задача автоматизировать ежедневную рутину: захожу на сайт, авторизовываюсь, захожу во вкладку отчеты, прописываю период, нажимаю выгрузить, жду, сохраняю файл. И так 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. А что будет с файлом и куда он сохранится и помыслить не могу  :)  
Страницы: 1
Наверх