Как скачать таблицу excel по ссылке

Хитрости »

2 Декабрь 2016              40483 просмотров

Как скачать файл из интернета по ссылке

Вся суть статьи уже в заголовке. Возникает порой необходимость скачивания файлов из интернета только на основании ссылки. Например, это какие-то постоянно меняющиеся данные или автоматически генерируемая другим кодом ссылка. Или еще более усугубленный вариант — строк 100 со ссылками на файлы, которые надо скачать…Вот уж радости руками по каждой клацать
Поэтому выкладываю решение, которое в большинстве случае поможет при помощи Visual Basic for Applications скачать файл на основании ссылки URL:

'---------------------------------------------------------------------------------------
' File   : mDownloadFileFromURL
' Purpose: код позволяет скачивать файлы из интернета по указанной ссылке
'---------------------------------------------------------------------------------------
Option Explicit
 
'объявление функции API - URLDownloadToFile
'   работает на любых ПК под управлением ОС Windows
'   на MAC код работать не будет
#If Win64 Then 'для операционных систем с 64-разрядной архитектурой
    Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
            (ByVal pCaller As LongLong, ByVal szURL As String, ByVal szFileName As String, _
             ByVal dwReserved As LongLong, ByVal lpfnCB As LongLong) As LongLong
#Else
    #If VBA7 Then 'для любых операционных систем с офисом 2010 и выше
        Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
            (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As String, _
                ByVal dwReserved As Long, ByVal lpfnCB As LongPtr) As LongPtr
    #Else 'для 32-разрядных операционных систем
        Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
                                        (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
                                        ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
    #End If
#End If
'переменная для хранения пути к папке
Dim sFilePath As String
 
Function CallDownload(sFileURL As String, sFileName As String)
'   sFileURL  - ссылка URL для скачивания файла
'   sFileName - имя файла с расширением, которое будет присвоено после скачивания
 
    Dim h
    If sFilePath = "" Then
        'диалоговое окно выбора папки
        'подробнее: http://www.excel-vba.ru/chto-umeet-excel/dialogovoe-okno-vybora-fajlovpapki/
        With Application.FileDialog(msoFileDialogFolderPicker)
            If .Show = False Then
                Exit Function
            End If
            sFilePath = .SelectedItems(1)
        End With
    End If
 
    If Right(sFilePath, 1) <> "" Then sFilePath = sFilePath & ""
    'проверяем есть ли файл с таким же именем в выбранной папке
    If Dir(sFilePath & sFileName, 16) = "" Then
        'файла нет - скачиваем
        h = DownloadFileAPI(sFileURL, sFilePath & sFileName)
    Else
        'файл есть - запрос на перезапись
        If MsgBox("Этот файл уже существует в папке: " & sFilePath & vbNewLine & "Перезаписать?", vbYesNo, "www.excel-vba.ru") = vbYes Then
            'если существующий файл открыт - невозможно его перезаписать, показываем инф.окно
            'отменяем загрузку
            If IsBookOpen(sFileName) Then
                MsgBox "Невозможно сохранить файл в указанную папку, т.к. она уже содержит файл '" & sFileName & "' и этот файл открыт." & _
                    vbNewLine & "Закройте открытый файл и повторите попытку.", vbCritical, "www.excel-vba.ru"
            Else
                h = DownloadFileAPI(sFileURL, sFilePath & sFileName)
            End If
        End If
    End If
    CallDownload = h
End Function
 
'функция скачивания файла в выбранную папку
Function DownloadFileAPI(sFileURL, ToPathName)
'   sFileURL   - ссылка URL для скачивания файла
'   ToPathName - полный путь с именем файла для сохранения
 
    Dim h
    Dim sFilePath As String
    Dim sFileName As String
    'вызов функции API для непосредственно скачивания
    h = (URLDownloadToFile(0, sFileURL, ToPathName, 0, 0) = 0)
    'если h = False - файл не удалось скачать, показываем инф.окно
    If h = False Then
        MsgBox "Невозможно скачать файл." & vbNewLine & _
                "Возможно, у Вас нет прав на создание файлов в выбранной директории." & vbNewLine & _
                "Попробуйте выбрать другую папку для сохранения", vbInformation, "www.excel-vba.ru"
                Exit Function
    Else 'файл успешно скачан
            sFileName = Dir(ToPathName, 16)
            sFilePath = Replace(ToPathName, sFileName, "")
            If MsgBox("Файл сохранен в папку: " & sFilePath & _
                              vbNewLine & "Открыть файл сейчас?", vbYesNo, "www.excel-vba.ru") = vbYes Then
                If IsBookOpen(sFileName) Then
                    MsgBox "Файл с именем '" & sFileName & "' уже открыт. Закройте открытый файл и повторите попытку.", vbCritical, "www.excel-vba.ru"
                Else
                    Workbooks.Open ToPathName
                End If
            End If
    End If
    DownloadFileAPI = h
End Function
'Функция проверки - открыта ли книга с заданным именем
'подробнее:
'        http://www.excel-vba.ru/chto-umeet-excel/kak-proverit-otkryta-li-kniga/
Function IsBookOpen(wbName As String) As Boolean
    Dim wbBook As Workbook
    For Each wbBook In Workbooks
        If Windows(wbBook.Name).Visible Then
            If wbBook.Name = wbName Then IsBookOpen = True: Exit For
        End If
    Next wbBook
End Function

Код необходимо скопировать и вставить в книгу в стандартный модуль. Макросы должны быть разрешены.

Основная функция, отвечающая за непосредственно скачивание — это функция API(Application Programming Interface) URLDownloadToFile. Она объявлена в самом верху кода. Там есть страшные директивы вроде #If Win64 Then. Это особые директивы, которые работают даже вне процедур. Поэтому не надо удивляться, что они вне всяких Sub и тем более не надо эти Sub-ы добавлять. При этом так же не надо удивляться, если какие-то из строк внутри этих директив будут подсвечены компилятором VBA красным шрифтом. На функциональность это не повлияет.

Вызов скачивания файла происходит обычным обращением к функции CallDownload. Например, есть ссылка для скачивания: http://www.excel-vba.ru/files/book.xls. И сохранить надо под именем «Книга1.xls». Вызываем функцию скачивания файла:

Sub DownloadFile()
    Call CallDownload("http://www.excel-vba.ru/files/book.xls", "Книга1.xls") 'вызываем скачивание файла
End Sub

Функция сама запросит папку для сохранения файла и после скачивания предложит открыть этот файл. Если такой файл уже есть — будет предложено его перезаписать.
К статье приложен файл, в котором код чуть расширен — он позволяет скачивать файлы сразу из множества ячеек, проставляя при этом признак — скачан файл или нет. И если сразу весь список обработать не получилось и какие-то файлы остались не скачанные(например, имена совпадали, а заменять файлы не надо было), то в этом случае можно будет повторно запустить код и скачиваться будут лишь те, у которых статус не является «Скачан!».
Так же т.к. ячеек много, перед скачиванием файлов будет выбор — запрашивать ли открытие файлов после скачивания или нет. Если открывать не надо, следует ответить Нет. Тогда файлы просто будут скачаны в указанную папку. Однако, если в этой папке будут расположены файлы с идентичными именами — запрос на перезапись все же появится, при этом для каждого файла. Если подобный запрос так же мешает, то надо этот блок:

    'проверяем есть ли файл с таким же именем в выбранной папке
    If Dir(sFilePath & sFileName, 16) = "" Then
        'файла нет - скачиваем
        h = DownloadFileAPI(sFileURL, sFilePath & sFileName)
    Else
        'файл есть - запрос на перезапись
        If MsgBox("Этот файл уже существует в папке: " & sFilePath & vbNewLine & "Перезаписать?", vbYesNo, "www.excel-vba.ru") = vbYes Then
            'если существующий файл открыт - невозможно его перезаписать, показываем инф.окно
            'отменяем загрузку
            If IsBookOpen(sFileName) Then
                MsgBox "Невозможно сохранить файл в указанную папку, т.к. она уже содержит файл '" & sFileName & "' и этот файл открыт." & _
                    vbNewLine & "Закройте открытый файл и повторите попытку.", vbCritical, "www.excel-vba.ru"
            Else
                h = DownloadFileAPI(sFileURL, sFilePath & sFileName)
            End If
        End If
    End If

заменить на всего одну строку:

h = DownloadFileAPI(sFileURL, sFilePath & sFileName)

Но при этом надо помнить — что при этом можно потерять какие-то важные файлы. Поэтому подобные вещи вы делаете на свой страх и риск.

Однако следует помнить одну вещь: не все сайты вот так запросто разрешают скачивать с них файлы, тем более пачками. Особенно это актуально для всякого рода форексов и иже с ними. Возможно, получится скачать один, два, три — десять файлов. Но всегда может случиться так, что сайт просто заблокирует ваш IP до конца дня, т.к. на сайте установлено ограничение на автоматизированное обращение извне. При этом для разных сайтов решение данной проблемы может быть различным и не всегда решаемым

Скачать файл

  Tips_Macro_DownloadFileFromURL.xls (64,0 KiB, 3 838 скачиваний)

Статья помогла? Поделись ссылкой с друзьями!

    Видеоуроки

Поиск по меткам



Access
apple watch
Multex
Power Query и Power BI
VBA управление кодами
Бесплатные надстройки
Дата и время
Записки
ИП
Надстройки
Печать
Политика Конфиденциальности
Почта
Программы
Работа с приложениями
Разработка приложений
Росстат
Тренинги и вебинары
Финансовые
Форматирование
Функции Excel
акции MulTEx
ссылки
статистика

Среди пользователей, создающих электронные таблицы, есть те, которые предпочитают онлайн-сервис от Google, а другие работают в Microsoft Excel. Поэтому иногда возникает потребность перенести данные из веб-сервиса непосредственно в программу.

Сделать это можно тремя разными методами.

Способ 1: Скачивание таблицы в формате XLSX

Если вы еще не знаете, то Google Таблицы поддерживают скачивание созданного документа в одном из шести форматов, среди которых есть и XLSX – фирменный формат Microsoft Excel. У этого способа есть свой минус, поскольку вы не сможете путем нажатия одной кнопки обновлять данные и просматривать, какие изменения были внесены онлайн. Однако если это и не нужно, скачивание будет самым простым и быстрым решением.

1. Откройте необходимую таблицу через любой удобный браузер с того аккаунта, который имеет доступ к просмотру. Вызовите меню «Файл», наведите курсор на «Скачать» и выберите вариант «Microsoft Excel (XLSX)».

2. Дождитесь окончания загрузки и откройте документ через программу.

3. Обязательно разрешите редактирование, поскольку изначально файл будет открыт в режиме защищенного просмотра.

4. Теперь все инструменты Excel станут активными, и вы сможете вносить необходимые изменения на листе.

Способ 2: Импорт запроса

Теперь предлагаю рассмотреть более сложные, но прогрессивные методы, позволяющие оперативно отслеживать вносимые изменения в Google Таблицах и работать с актуальными данными в Excel. Этот вариант подразумевает открытие доступа по ссылке к документу с последующим импортом таблицы в Excel, что выглядит следующим образом:

1. Попросите владельца документа выполнить следующие действия или сделайте это самостоятельно. Если вы уже получили ссылку доступа, пропустите этап настройки и переходите сразу к Excel. В противном случае в документе нажмите на «Настройка доступа».

2. В появившемся окне щелкните по ссылке «Разрешить доступ всем, у кого есть ссылка».

3. Скопируйте полученную ссылку. Уровень доступа при этом не имеет значения, поэтому можете оставить стандартное значение – «Читатель».

4. Откройте пустой лист в Excel, перейдите на вкладку «Данные», разверните меню «Создать запрос», выберите «Из других источников» и щелкните по варианту «Из Интернета».

5. Вставьте ссылку в появившемся окне.

6. Суть изменения заключается только в исправлении последней части на export?format=xlsx вместо edit?usp=sharing.

7. После этого нажмите «ОК» и дождитесь появления нового окна. В нем выберите импорт нескольких листов или укажите конкретный.

8. Через средство предпросмотра убедитесь в том, что выбрали правильный лист, после чего подтвердите его загрузку.

9. Импорт прошел успешно, хоть и форматирование может немного отличаться от оригинального.

10. Для проверки изменений на вкладке «Данные» используйте кнопку «Обновить все».

11. Как видно, кто-то внес изменения в Google Таблицах, и они успешно подгрузились в Excel без необходимости снова импортировать всю таблицу.

12. Для настройки времени автоматического обновления в меню «Обновить все» нажмите на «Свойства подключения».

13. Активируйте «Обновлять каждые» и укажите желаемое количество минут.

Крайне редко стиль ссылок для доступа меняется, что связано с выпускаемыми Google обновлениями. Случается это действительно очень редко, но если вы столкнулись с тем, что таблица в один момент перестала загружаться, проверьте еще раз ссылку. Если же к листу прекратить доступ по ссылке, загрузка данных в Excel тоже не выполнится.

Способ 3: Импорт файла CSV

Предлагаю обратить внимание на этот вариант, если с реализацией предыдущего возникли какие-то проблемы. У импорта файла CSV есть свои недостатки, поскольку весь документ в Google Таблицах придется сделать публичным. Если для вас это не имеет значения, приступайте к выполнению инструкции.

1. В Google Таблицах откройте меню «Файл», наведите курсор на «Открыть доступ» и щелкните по варианту «Опубликовать в интернете».

2. Решите, будет ли это публикация всего документа или только одного листа.

3. Из следующего меню выберите вариант «Файл CSV».

4. Активируйте автоматическую публикацию после внесения изменений.

5. По завершении нажмите кнопку «Начать публикацию».

6. Скопируйте полученную ссылку и переходите в Excel.

7. На вкладке «Данные» выберите вариант создания запроса «Из файла» и «Из CSV».

8. Вместо имени файла в новом окне вставьте полученную ссылку и нажмите на «Открыть».

9. Загрузка данных займет пару минут, после чего появится таблица, но вместо всех надписей будут «кракозябры». Для исправления разверните список «Источник файла» и выберите «Юникод (UTF-8)».

10. Если вся информация отображается корректно, подтвердите загрузку и начните работать с таблицей.

Обновление данных осуществляется точно так же, как это было показано в предыдущей инструкции, поэтому можете вернуться к ее последним шагам, чтобы получить соответствующую информацию по теме.

Принцип работы двух последних способов практически не отличается, разница лишь в методе импорта данных. При этом в третьем способе проблем после обновления ссылок не замечено, но есть и минус, связанный с публикацией, о котором уже шла речь выше. Поэтому взвесьте все за и против и выберите подходящий для себя вариант переноса листов из Google Таблиц в Excel.

Перейти к содержимому

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

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

#If VBA7 Then        '  Office 2010-2013
    Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
            (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As String, _
             ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) As LongPtr
#Else        '  Office 2003-2007
    Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
                                       (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
                                        ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If
 
Function DownLoadFileFromURL(ByVal URL$, ByVal LocalPath$, Optional ByVal DisableCache As Boolean = False) As Boolean
    On Error Resume Next
    If (LocalPath$ = "") Or (URL$ = "") Then Exit Function
    If Not LocalPath$ Like "**" Then LocalPath$ = Environ("TEMP") & "" & LocalPath$
    Kill LocalPath$
    If DisableCache Then Randomize: URL$ = URL$ & "?rnd=" & Left(Rnd(Now) * 1E+15, 10)
    DownLoadFileFromURL = URLDownloadToFile(0, URL$, LocalPath$, 0, 0) = 0
End Function

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

Sub ПримерИспользования()
    СсылкаНаФайл$ = "http://excelvba.ru/sites/default/files/3.jpg"
    ПутьДляСохранения$ = "C:1.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