mail mail

Скачать файл из интернета без использования WinAPI

Часто требуется макросом скачать некий файл из интернета.
Обычно в этом помогает WinAPI-функция URLDownloadToFile, но есть также возможность загрузить файл без её использования:

Чем чревато использование функции URLDownloadToFile - по сути, ничем, кроме как необходимостью прописывать её в 4 вариантах,
для обеспечения совместимости с 64-битной Windows и Office 2010

Я же предлагаю другое решение - функцию DownloadFile с использованием объектов Microsoft.XMLHTTP и ADODB.Stream:

 

Sub ПримерИспользования()
    СсылкаНаФайл$ = "http://excelvba.ru/sites/default/files/3.jpg"
    ПутьДляСохранения$ = "C:\ПЖиВ.jpg"

    ' скачиваем файл из интернета
   DownloadFile СсылкаНаФайл$, ПутьДляСохранения$

    ' открываем скачанный файл
   CreateObject("wscript.shell").Run """" & ПутьДляСохранения$ & """"
End Sub

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

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Воспользовался этой функцией, но столкнулся с затруднением: при отсутствии интернета файл "достается" из локального кеша, в большинстве случаев это не проблема, но я проверяю дату последних обновлений, которая лежит в текстовом файле на сайте.
Решение: между строк
XMLHTTP.Open... и XMLHTTP.send
воткнуть
XMLHTTP.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"

Спасибо! Работает.

Спасибо!

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
18 + 0 =
Решите эту простую математическую задачу и введите результат. Например, для 1+3, введите 4.