Страницы: 1
RSS
Получение файла по HTTP запросу
 
Добрый вечер.

Осуществляю общение с интернет сервисом, так вот, на мои запросы он мне присылает JSON,я с ним вроде разобрался, принимаю и парсю, но есть методы которые запрашивают формирование отчета и оформление его в PDF или Excel, так вот как мне этот файл принять и сохранить?
 
Вот так вот я джейсоны получаю
Код
Function GetHTTPResponse(ByVal sURL As String, Token As String, Metod As String)
    Dim logpass As String
    On Error Resume Next
    Set client = CreateObject("MSXML2.XMLHTTP")
    With client
      .Open "GET", sURL & Metod, False
      .SetRequestHeader "Content-Type", "application/json"
      .SetRequestHeader "AG-TOKEN", Token
      .send
       GetHTTPResponse = .ResponseText
    End With
    Set client = Nothing
End Function
 
У меня складывается впечатление, что MSXML2.XMLHTTP, в вопросе получения файла в ответе на GET запрос, мне не поможет?
 
Сейчас посмотрел переменную, что то там приходет в ответ, на нечеловеческом языке, в заголовке говориться, что это pdf, теперь думаю как это чудо сохранить в файл с расширением pdf
 
Код
With New WinHttpRequest
    .Open "GET", DownloadURL$, False

    .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"

    .Send: DoEvents

    ' сохраняем ответ сервера в файл
    If .Status = 200 Then
        res = True
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write .ResponseBody
        oStream.SaveToFile Filename$, 2        ' 1 = no overwrite, 2 = overwrite
        oStream.Close
    Else
        Debug.Print "error downloading file: Status = " & .Status
    End If
End With

или так
Код
Function DownloadFile(ByVal URL$, ByVal LocalPath$) As Boolean
    ' Функция скачивает файл по ссылке URL$
    ' и сохраняет его под именем LocalPath$
    Dim XMLHTTP, ADOStream, FileName
    On Error Resume Next: Kill LocalPath$
 
    Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")
    XMLHTTP.Open "GET", Replace(URL$, "\", "/"), "False"
    XMLHTTP.send
    If XMLHTTP.statustext = "OK" Then
        Set ADOStream = CreateObject("ADODB.Stream")
        ADOStream.Type = 1: ADOStream.Open
        ADOStream.Write XMLHTTP.responseBody
 
        ADOStream.SaveToFile LocalPath$, 2
        ADOStream.Close: Set ADOStream = Nothing
        DownloadFile = True
    Else
        'MsgBox "Не удаётся скачать файл " & XMLHTTP.statustext
    End If
    Set XMLHTTP = Nothing
End Function

А имя файла можно брать из заголовка ответа сервера, - примеры кода есть на форумах
 
Немного не понимаю, то есть, я должен получить ответ от сервера, в ответе будет ссылка на файл, я тут же должен обратиться к серверу за файлом?

Методом проб и ошибок я увидел, что все таки сервер присылает мне в ответ и он загоняется в текстовую переменную. Я посмотрел содержимое этой переменной, оно имеет такой же вид, как если бы я переименовал pdf файл в txt и открыл блокнотом, встает вопрос, как правильно сохранить эту фесчь, чтоб потом pdf файл открывался, сейчас он у меня числиться поврежденным
 
Спасибо большое, научился, красота просто)))
 
Использовал второй код
 
Вот что у меня получилось и то что работает как часы
Код
Function GetHTTPResponsePDF(ByVal sURL As String, Token As String, Metod As String)
    Dim logpass As String
    On Error Resume Next
    Set client = CreateObject("MSXML2.XMLHTTP")
    With client
      .Open "GET", sURL & Metod, False
      .SetRequestHeader "Content-Type", "application/json"
      .SetRequestHeader "AG-TOKEN", Token
      .send
    End With
    
    If client.statustext = "OK" Then
        Set ADOStream = CreateObject("ADODB.Stream")
        ADOStream.Type = 1: ADOStream.Open
        ADOStream.Write client.responseBody
  
        ADOStream.SaveToFile "C:\Рабочие документы\Вспомогательные программы\Отчеты сервиса\" & UserForm1.ListBoxObject.List(UserForm1.ListBoxObject.ListIndex, 0) & "-" & _
                                            UserForm1.ListBoxObject.List(UserForm1.ListBoxObject.ListIndex, 1) & ".pdf", 2
        ADOStream.Close: Set ADOStream = Nothing
        DownloadFile = True
    Else
        'MsgBox "Не удается скачать файл" & XMLHTTP.statustext
    End If
    GetHTTPResponsePDF = client.ResponseText
    Set client = Nothing
End Function
Страницы: 1
Читают тему
Наверх