Загрузка изображений из интернета по ссылкам в одну папку

Загрузка файлов (изображений) из интернета

Макрос предназначен для загрузки изображений (или любых других файлов) из интернета, и сохранения скачанных файлов в одну папку.

Исходные данные для работы макроса:

таблица, в которой содержатся по меньшей мере 2 столбца - один с гиперссылками, второй - с именами файлов.

Особенности макроса:

  • создаваемым файлам присваиваются имена из выбранного столбца листа Excel
  • макрос корректно работает со ссылками, содержащими символы кириллицы
  • автоматическое добавление расширения для скачиваемых файлов (если имя файла из ячейки его не содержит)

Если вам требуется вставлять много изображений на лист Excel, - то вам поможет надстройка, позволяющая производить поиск изображений в заданной папке, и производить вставку картинок в ячейки или примечания

Кроме того, надстройка для вставки изображений в Excel умеет загружать картинки из интернета (по ссылкам в таблице Excel)

Бесплатно скачать надстройку вставки картинок в Excel

 

Настройки макроса легко выполнить, изменив в коде значения констант:

    Const НазваниеПапкиДляФайлов$ = "Фотографии"    ' так будет называться создаваемая папка
    Const НомерСтолбцаСГиперссылками = 6    ' из этого столбца макрос берет гиперссылки для загрузки файлов
    Const НомерСтолбцаСИменамиФайлов = 4    ' из этого столбца макрос берет имена для создаваемых файлов
    Const НомерПервойСтрокиСДанными = 2    ' с какой строки листа начинаем обрабатывать данные
    Const РасширениеФайлов$ = ".jpg"    ' этот текст добавляется справа к именам создаваемых файлов

Смотрите также аналогичный (более сложный) макрос загрузки изображений

Код основного макроса:

Sub СкачатьИзображения()
    Const НазваниеПапкиДляФайлов$ = "Фотографии"    ' так будет называться создаваемая папка
    Const НомерСтолбцаСГиперссылками = 6    ' из этого столбца макрос берет гиперссылки для загрузки файлов
    Const НомерСтолбцаСИменамиФайлов = 4    ' из этого столбца макрос берет имена для создаваемых файлов
    Const НомерПервойСтрокиСДанными = 2    ' с какой строки листа начинаем обрабатывать данные
    Const РасширениеФайлов$ = ".jpg"    ' этот текст добавляется справа к именам создаваемых файлов

    Dim sh As Worksheet, cell As Range, ra As Range: Application.ScreenUpdating = False
    ПапкаДляФайлов$ = ThisWorkbook.Path & "\" & НазваниеПапкиДляФайлов$ & "\"
    On Error Resume Next: MkDir ПапкаДляФайлов$    ' создаём папку, если её ещё нет

    Dim pi As New ProgressIndicator
    pi.Show "Загрузка файлов из интернета"
    Set sh = ActiveSheet    ' обрабатываем только активный лист

    ' диапазон заполненных ячеек в столбце НомерСтолбцаСГиперссылками (без строк заголовка таблицы)
    Set ra = sh.Range(sh.Cells(НомерПервойСтрокиСДанными, НомерСтолбцаСГиперссылками), _
                      sh.Cells(sh.Rows.Count, НомерСтолбцаСГиперссылками).End(xlUp))
    pi.StartNewAction , , "Загрузка файлов", , , ra.Cells.Count
 
    For Each cell In ra.Cells    ' перебираем все ячейки диапазона
        ' формируем путь к новому файлу, заменяя запрещённые символы в имени файла на _подчеркивание_
        ИмяФайла$ = ПапкаДляФайлов$ & Replace_symbols(cell.EntireRow.Cells(НомерСтолбцаСИменамиФайлов))
        If Not ИмяФайла$ Like "*" & РасширениеФайлов$ Then ИмяФайла$ = ИмяФайла$ & РасширениеФайлов$
 
        ' обрабатываем ссылку, преобразуя её в URLEncode
        Ссылка$ = RussianStringToURLEncode(cell.Text)
 
        pi.SubAction , "Строка: " & cell.Row, "Файл: " & ИмяФайла$
        ' сохраняем очередную ссылку в виде файла в  папку
        If DownLoadFile(Ссылка, ИмяФайла) Then
            FilesCount% = FilesCount% + 1    ' Debug.Print "Скачан файл: " & Ссылка
        Else
            MsgBox "Не удалось загрузить файл " & Ссылка, vbCritical
        End If
    Next cell
    pi.Hide    ' закрываем прогресс-бар
    Application.ScreenUpdating = True
    msg = "Обработано ссылок: " & ra.Cells.Count & ".  Загружено файлов: " & FilesCount% & vbNewLine
    msg = msg & "Файлы помещены в папку """ & ПапкаДляФайлов$ & """"
    MsgBox msg, vbInformation, "Загрузка файлов завершена"
End Sub

Вложения:

Комментарии

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

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

Здравствуйте.

скачивании через скрипт - нет

"Нет" — что нет?
Не скачивается?
Не отображается в Excel?
Не открывается скачанный в папку, при щелчке мышью?
По какой ссылке скачиваете?

Не экономьте слова, если хотите получить ответ.

Добрый день! При ручном вводе гиперссылки в адресную строку и ручном скачивании файл gif открывается при скачивании через скрипт - нет. Подскажите в чем может быть проблема ?

Всё возможно.
В статье есть ссылка на платную версию этого макроса, там есть такая возможность.

Отличный парсер, одного только не хватает...
Жесткая привязка к 4й строке. Возможно ли сохранять название такое же как в оригинале?

СПАСИБО СПАСИБО СПАСИБО

Нужно дорабатывать вызов апи функции под 64-битную систему.
В статье есть ссылка на готовое решение в виде надстройки, которое работает на всех версиях windows

На 64-разрядной винде выдает ошибку http://prntscr.com/q5311b - что нужно сделать чтобы заработало?

Спасибо за предоставленный на блюдечке солюшн)

Добрый день! Решил скачать изображения через макрос, сделал все как полагается, загрузил ссылки на изображения формата "https://fireboxbiz.com/i24i.php?connect=00000015417&foto=3DSC_3200.jpg&razdel=tovar&h=1250&w=1000". Однако при запуске, макрос выдает ошибку "Нне удалось загрузить файл". В браузере по ссылкам открывается все нормально. Подскажите, пожауйста, как избавиться от этой ошибки, если вообще возможно

Возможно, сервер выдаёт файлы с большой задержкой
И процесс загрузки некоторых фото длится минуту вместо секунды
Для подобного макроса, и 10 тыс фото загрузить не является проблемой. Ничего тормозить / подвисать не должно, если фотки скачиваются нормально.

Автору спасибо за полезный макрос!
Вопрос: при большом кол-ве файлов (например 1500), происходят скачки, типа Эксель завис, но потом вроде отпускает. А пару раз вообще выбивало эксель.
С чем может быть связано? Ноут рабочий, мощный вроде.

Макросу не важно, какого формата скачиваемые файлы.
Скачивает абсолютно одинаково любые файлы.

Добрый день. Скачал макрос работает нормально, но архивы и файлы pdf не скачивает, хотелось бы чтобы все форматы качались, что нужно для этого сделать?

Отличное решение. Кручем чем ДМ Мастер. Автору огромное спасибо;)

Спасибо за решение.
Макрос запустился без проблем.
Единственное, для себя доработал немного информацию, чтобы не выскакивало окно о том, что файл не загружен, а сделал автоматическую отметку напротив строки об этом (так не надо сидеть и пушить кнопку на msg)
1115 фото скачано за 30 секунд.

По бесплатным макросам техподдержки нет
Могу сделать под заказ (платно), обращайтесь на почту или в Скайп

Подскажите, пожалуйста, как использовать функцию из 41 комментария для извлечения имени файла из ссылки в данном макросе?

ОГРОМНОЕ СПАСИБО!!!

Что делать - ниже написано.
Либо код исправлять, либо воспользоваться работающим вариантом:
http://excelvba.ru/programmes/PastePictures

не работает на 64 битной системе((( Что делать?

Поменять Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA"
на Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA"

Добрый день! Скачал файл-пример ваш и сразу получаю такую ошибку:
Compile error:
The code in this project must be updated for use on 64-bit systems.
Я тут один с такой проблемой? помогите решить) Спасибо

Макрос никакой доступ не просит
Техподдержки по бесплатным макросам нет.

Если подойдёт платное готовое решение (1500 руб стоит) - скачайте и пользуйтесь:
http://excelvba.ru/programmes/PastePictures
А если хотите бесплатно, - изучайте код, пробуйте его адаптировать, - но это уже без моей помощи.

а зачем далее макрос просит доступ ко всему рабочему столу, например?

его нужно просто проиграть из открытого вашего файла? или все же вставлять в новый?
в обеих файлах 0% загрузки изображений висит очень долго

Надо взять весь код из прикрепленного файла (прогрессбар - форма и модуль класса)
В статье опубликована лишь основная часть кода (не весь код)

А что делать, если выдает ошибку:

Ошибка компиляции:

Пользовательский тип не определен
(Лист1 11:8)

Шикардос. Спасибо.

Здравствуйте. Вставил данный макрос В нужный мне файл, запускаю – выдает: ошибка компиляции: пользовательский тип не определен, А также открывает модуль В редакторе И подсвечивает следующую строку – Sub СкачатьИзображения()
Подскажите пожалуйста, что я неправильно делаю?

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

Да, возможно. Только кода много получается.
В программе для вставки картинок эта функция применена для сжатия изображений, - во папку «сжатые изображения» попадают файлы заданного размера в пикселах

Возможно ли с помощью VBA сохранять скачиваемые фото (или вообще любые другие) с принудительным размером в пикселях. (к примеру 50 на 50 пикселей)? То есть управлять не только названием файла, но и его свойством (размер)

Спасибо, помогло

Готовое решение есть по этой ссылке

Здравствуйте, помогите, пожалуйста, с макросом загрузки изображений. Нужно, чтобы он работал на 64bit Excel 2013. Готов приобрести готовое решение.

Спасибо) помогло

Ну так удалите в коде строку

 MsgBox "Не удалось загрузить файл " & Ссылка, vbCritical

Здравствуйте! Подскажите пожалуйста, если не сложно, как так сделать чтобы если ссылка на картинку не рабочая, то он просто переходил к следующей ячейке, а не выдавал постоянно ошибку?

все работает. спасибо за оперативный ответ!!!

Эльмира, значит, вы в 4 столбце не внесли имена файлов
Сколько имен файлов задано - столько строк и обрабатывается.

Можете попробовать более универсальное решение, - там больше возможностей, и всё настраивается через инстерфейс программы:
http://excelvba.ru/programmes/PastePictures

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

Большое спасибо, добрый человек! )) Все замечательно работает!

Вопрос непонятен
Если сайт ваш, - подключиться по FTP, получить список файлов, и скачать по-одному
Если сайт не ваш (доступа к нему нет), - то парсером сайтов перебрать все товары в категории, на каждой странице товара найти картинку, и сохранить её в файл

господа а как скачать все файлы картинок зная путь категории на сайте?

В статье выложена только часть кода.
Код полностью, - в прикреплённом файле (там все будет работать без ошибок)

Здравствуйте.
Помогите пожалуйста.
Создала макрос, но появляется ошибка: user- defined type not defined
При этом выделяется строка: Dim pi As New ProgressIndicator
В чем может быть проблема?!
Спасибо!

я просто удалил эту строчку.
Const РасширениеФайлов$ = ".jpg" ' этот текст добавляется справа к именам создаваемых файлов

Добрый день!

1. Если Вы видите ошибку - проверьте наименование, плохо обрабатывает "/", а он запрещен в имени файла в Виндовс.
2. Когда много файлов нужно сохранить, то ошибки необходимо выделить, чтоб руками узнать "какие это ошибки"
Нашел в интернете такой вариант:
=====
If cell Like "*" & Ссылка & "*" Then
iStart = InStr(cell.Value, Ссылка)
With cell.Characters(Start:=iStart, Length:=Len(Ссылка)).Font
.Bold = True
.Color = -65536
End With
End If
=====
Добавляем код перед выводом ошибки.

Не полностью уверен в правильности написания, чувствую можно сократить, но с моей задачей полностью справился и вдруг вам пригодится.

В другом макросе Вы уже давали ответ на этот вопрос в виде кода:

mid(cell.EntireRow.Cells(i).Text, instrrev(cell.EntireRow.Cells(i).Text, "."))

Но я не нашел варианта как его применить именно в этом макросе... :(

Я уточню вопрос. Как сделать так, чтобы Ваш макрос брал расширение не из параметра Const РасширениеФайлов$ а из ссылки. Спасибо!!!

Простите, но мне не нужна его доработка и скачивание за меня файлов на каком-то промышленном уровне... Это чисто для личного семейного архива фотографий... Давайте вопрос с пробелом не будем решать. Просто скажите, как сохранить расширение файла, взяв его из ссылки? Вы ниже уже отвечали человеку на этот счет, но я не разобрался как это вставить в макрос... Спасибо!

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

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  ____            _____           ____          
| ___| _ __ |___ | __ _ / ___| __ _
|___ \ | '_ \ / / / _` | \___ \ / _` |
___) | | |_) | / / | (_| | ___) | | (_| |
|____/ | .__/ /_/ \__,_| |____/ \__,_|
|_|
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

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