Макрос предназначен для загрузки изображений (или любых других файлов) из интернета, и сохранения скачанных файлов в одну папку.
Исходные данные для работы макроса:
таблица, в которой содержатся по меньшей мере 2 столбца - один с гиперссылками, второй - с именами файлов.
Особенности макроса:
- создаваемым файлам присваиваются имена из выбранного столбца листа 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 РасширениеФайлов$ а из ссылки. Спасибо!!!
Простите, но мне не нужна его доработка и скачивание за меня файлов на каком-то промышленном уровне... Это чисто для личного семейного архива фотографий... Давайте вопрос с пробелом не будем решать. Просто скажите, как сохранить расширение файла, взяв его из ссылки? Вы ниже уже отвечали человеку на этот счет, но я не разобрался как это вставить в макрос... Спасибо!
Отправить комментарий