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

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

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

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

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

Вложения:

Комментарии

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

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

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

Так, может, у вас ссылки ведут не на картинки, а на страницы товаров с текстом и картинками?
Попробуйте воспользоваться этой программой, она более универсальная:
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", как в названии добавить недостающие нули?

Антонина, надо было заменит в коде строку

Ссылка$ = RussianStringToURLEncode(cell.Text)

на

Ссылка$ = RussianStringToURLEncode(cell.Hyperlinks(1).Address)

чтобы брался не ТЕКСТ из ячейки, а ГИПЕРССЫЛКА из неё

Выслал файл с исправлениями на почту

Отправила файл на почту

прошу прощения, не в имя файла, а имя гиперссылки :(

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

Доброго времени суток! Скажите а как пользоваться макросом, если имя гиперссылки >>, хотя ссылка верная. Пишет невозможно загрузить файл. Пробовала вставлять в имя файла гиперссылку, тогда работает. У меня огромный массив, помогиииииииите! :)

Спасибо! Буду разбираться!

Здравствуйте, Дмитрий.

Как-то так это делается:

    Dim sha As Shape
    For Each sha In ActiveSheet.Shapes        ' перебираем все картинки на листе
        If Not sha.Hyperlink Is Nothing Then        ' если картинке назначена гиперссылка
            Link$ = sha.Hyperlink.Address        ' получаем адрес ссылки

            ИмяФайла = "c:\test"
            If DownLoadFile(Link$, ИмяФайла) Then        ' пробуем скачать файл
                Debug.Print "Скачан файл: " & Link$
            Else
                MsgBox "Не удалось загрузить файл " & Link$, vbCritical
            End If
        End If
    Next

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

Заранее спасибо!

Быстрота и полнота ответа - вне конкуренции!

Здравствуйте, Василий.

Замените строку

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

на что-то вроде этого:

DownLoadFile "http...тут нужная ссылка на NoPhoto.jpg", ИмяФайла ' скачиваем из интернета

или на

FileCopy "Полный путь к файлу NoPhoto.jpg на вашем компе", ИмяФайла ' копируем файл

Как изменить макрос, чтобы для тех ссылок, по которым нет изображений, сохранялось изображение по одной фиксированной ссылке (из интернет или на локальном компьютере)?
*Изображение "NoPhoto".

заменил строку
Ссылка$ = RussianStringToURLEncode(cell.Text)
на
Ссылка$ = RussianStringToURLEncode(cell.Hyperlinks(1).Address)
и скачивает не зависимо от отображения ссылки в ячейке

п.с. Спасибо огромное за макрос и ответ!!!:)

заменил cell.Value = cell.Value на cell.Value = addr$ и заработало

как я понял ячейка должна выглядеть так "http://адрес сайта/photo/001.jpg", но
в офис 2010 функция FormulaHyperlink заменяет =ГИПЕРССЫЛКА("http://адрес сайта/photo/001.jpg";"фото") на "фото" и картинка не скачивается

MaldeR, в случае гиперссылок, выполненных при помощи формул, надо либо сначала их преобразовать в обычные гиперссылки,
либо при помощи функции FormulaHyperlink получить адрес ссылки из ячейки с формулой, перед выполнением загрузки файла:

Function FormulaHyperlink(ByRef cell As Range) As String
    If cell.HasFormula And (cell.Hyperlinks.Count = 0) Then
        If cell.Formula Like "=HYPERLINK*" Then
            FormulaHyperlink = Evaluate(Mid$(Split(cell.Formula, ",")(0), 12))
        End If
    End If
End Function

Необходимая функция и макрос замены гиперссылок есть в этой статье: http://excelvba.ru/code/FormulaHyperlinks

что делать, если ссылка в таком виде?
=ГИПЕРССЫЛКА("http://адрес сайта/photo/001.jpg";"фото")

Разобрался сам, удалил следующее
Else
MsgBox "Не удалось загрузить файл " & Ссылка, vbCritical

и все стало работать как мне надо. Еще раз большое спасибо !!!!!

Столкнулся с единственной проблеммой - если строчка пустая то выводится сообщение "Не удалось загрузить файл", а так как таких строк у меня очень много (не ко всем товарам имеется изображение) давольно таки не удобно постоянно сообщение закрывать.... есть ли вариант убрать это сообщение из кода?????
Заранее благодарствую.

Отличный макрос!!!! Автору БОЛЬШОЕ СПАСИБО!!!!!!!

За обрабатываемый диапазон ячеек отвечает эта строка в коде:

Set ra = sh.Range(sh.Cells(НомерПервойСтрокиСДанными, НомерСтолбцаСГиперссылками), _
                      sh.Cells(sh.Rows.Count, НомерСтолбцаСГиперссылками).End(xlUp))

Если надо обработать строки заданного диапазон, можете заменить эту строку следующим кодом:
(выберите наиболее подходящий вариант из трёх предложенных)

    ' будут обработаны гиперссылки в строках с 8-й по 25-ю включительно
    Set ra = sh.Range(sh.Cells(8, НомерСтолбцаСГиперссылками), sh.Cells(25, НомерСтолбцаСГиперссылками))

    ' будут обработаны гиперссылки в диапазоне ячеек d4:d32
    Set ra = sh.Range("d4:d32")

    ' будут обработаны гиперссылки в столбце НомерСтолбцаСГиперссылками ТОЛЬКО ДЛЯ ВЫДЕЛЕННЫХ СТРОК
    ' (достаточно, чтобы в строке была выделена хоть одна ячейка)
    Set ra = Range(Selection.EntireRow, Columns(НомерСтолбцаСГиперссылками))

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

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

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

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

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