mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

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

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

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

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

таблица, в которой содержатся по меньшей мере 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

ВложениеРазмерЗагрузкиПоследняя загрузка
DownloadPictures2.xls91.5 КБ1055 недель 9 часов назад

Комментарии

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

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

Поменять 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 РасширениеФайлов$ а из ссылки. Спасибо!!!

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

Антон, можем сделать под заказ (если готовы оплатить)
Оформляйте заказ на сайте, прикрепляйте пример файла Excel со ссылками, и описывайте, что куда скачивать.

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

И обнаружил проблему, если у ссылки на картинку в конце пробел, то картинка скачаться не может. Можно как-то автоматически это исправить, чтобы макрос в случае обнаружения пробела после ссылки его не удалял?

Спасибо огромное!

Всё отлично! Разобрался!) Спасибки. Теперь остается допилить обработку в 1С для загрузки этих изображений.(Скачал 25 тыс. изображений за 3 мин.)

Владимир, обычно на одном сайте все картинки одного типа (JPG или PNG)
Потому, достаточно указать фиксированное расширение для скачиваемых картинок.
Ну или можно брать расширение файла из ссылки (если оно там есть)
Автоматически же определять тип скачанного файла (анализируя его структуру) - можно, но сложно (у меня нет макроса для этого)

Доброго времени суток!
Подскажите плиз, файл эксель: столбцы: артикул, наименование и ссылка на изображение в интернете. Макросом скачивает все изображения, НО после скачивания нет Типа файла. Мне важно что бы скачанный файл имел Имя и Тип, который имеется у файла в интернете. Можно ли такое изобразить?
Спасибо.

Так, может, у вас ссылки ведут не на картинки, а на страницы товаров с текстом и картинками?
Попробуйте воспользоваться этой программой, она более универсальная:
http://excelvba.ru/programmes/PastePictures

Не грузит файлы. подскажите как исправить? может у кого были тоже проблемы?

Роман, вот вам функция для извлечения имени файла из ссылки:

Function GetFilenameFromURL(ByVal txt) As String
    On Error Resume Next
    GetFilenameFromURL = Replace_symbols(Split(txt, "/")(UBound(Split(txt, "/"))))
End Function
 
Function Replace_symbols(ByVal txt As String) As String
    st$ = "/\:?*|""<>"        ' а эти символы - разрешены: ~!@#$%^=`
    For i% = 1 To Len(st$)
        txt = Replace(txt, Mid(st$, i, 1), "_")
    Next
    Replace_symbols = txt
End Function

Как её применить в имеющемся макросе, - надеюсь, сами разберётесь.

Друзья, подскажите, а как сделать чтобы имя файла оставалось таким же как и в ссылке?

спасибо)))

обратите внимание на строку кода

 Const НомерСтолбцаСИменамиФайлов = 4    ' из этого столбца макрос берет имена для создаваемых файлов

если в заданном столбце во всех строках - одно и то же значение, - то и создаваться будет один файл
(каждый раз перезаписывая старый файл)

есть список ссылок с фотографиями. при скачивании скачивается только 1 фото. Почему не скачиваются все одновременно и как это исправить?

СПАСИБО!!!
очень помогли!

Спасибо)))

Здравствуйте, Роман.
замените код

If DownLoadFile(Ссылка, ИмяФайла) Then
    FilesCount% = FilesCount% + 1    ' Debug.Print "Скачан файл: " & Ссылка
Else
    MsgBox "Не удалось загрузить файл " & Ссылка, vbCritical
End If

на

If DownLoadFile(Ссылка, ИмяФайла) Then
    FilesCount% = FilesCount% + 1
    cell.next = "успешно"
Else
    cell.next = "ошибка"
End If

Добрый День!

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

А можно не переименовывать файл, о оставить название скачанного?

Рузана, а как вы представляете себе упорядоченные картинки в папке?
Есть же возможность сохранить картинки под именами из заданного столбца, - в отдельном столбце проставьте числа типа 1,2,3 и т.д. (протянув их на нужное количество строк), и используйте этот столбец как имена файлов.
Единственный способ упорядочивания файлов в папке, - это сортировка по именам / дате создания / размеру файла,
так что других вариантов нет.
Возможно, подойдет и просто сортировка по дате создания, - картинки ведь создавались подряд, одна за другой.
Если между моментами создания файлов проходила хотя бы секунда, - есть шанс упорядочить картинки без дополнительных действий.

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

Я сохранила картинки с ссылок с файла excel, но они находятся в беспорядочном состоянии в папке, как их упорядочить, согласно тому,как они были расположены в excel?

В названии файла есть нули "0001243" при сохранении имя файла становится "1243", как в названии добавить недостающие нули?

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

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

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

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