contact
blog - スタッフブログ blog - スタッフブログ

blog スタッフブログ

【エクセル・マクロ】VBAでWEBページ上の画像をまとめてダウンロードする

株式会社ブレイブ「システム開発事業部」の工藤です！
2018年より、制作系案件のブログを書いていこうと思います。今回は、画像を自動で保存するプログラムを紹介します。
指定したページ上にある画像をまとめてローカルフォルダに保存する事が可能です！

保存したい画像が少ない場合は「右クリック => 名前を付けてファイルを保存」でも問題ないですが、複数あった場合は時間も手間もかかってしまうと思います。
今回はそんな時にあると便利なプログラム（VBA）を紹介します。

目次

画像取得の流れ

今回はWEBページ上の画像を取得するので

  • InternetExplorer（以下:IE）で、画像を取得したいページを開く
  • ページ内の全IMGタグを確認
  • 条件に合う画像をローカルの指定フォルダに保存

という流れになります。

画像ファイルのダウンロードには、WindwosAPIの「URLDownloadToFile」を使用します。

サンプルの使い方

サンプルファイルのダウンロード

  • 上記リンクからZIPファイルをダンロードして解凍します。
  • エクセル（image_download.xlsm）を開きます。
  • マクロを有効にします。
  • 「画像取得ページ URL」を記入します。（必須）
    • 画像を一括で取得したいWEBページのURLを指定します。
    • ※ 認証や、ログインが必要なページは取得出来ません。
  • 「保存先」を記入します。（任意）
    • 空欄の場合は「image_download.xlsm」と同じフォルダ内に画像が保存されます。
  • 「取得画像サイズ」を記入します。（任意）
    • アイコンのような小さな画像を省く為の、取得する画像サイズ（ピクセル）です。
  • 「取得」ボタンを押下します。
  • IEが立ち上がり、画像をダウンロードします。
  • IEが閉じ、ダウンロード数とエラー数を伝えるメッセージボックスが表示されます。
  • 指定したフォルダに画像が保存されていれば完了です。

9.

完了メッセージＢＯＸ
完了のメッセージBOXが表示されます。

10.

ダウンロード完了フォルダ
指定したフォルダに画像が保存されます。

サンプルプログラムの説明

動作確認環境

  • Windows10
  • Excel2007
  • InternetExplorer11

参照設定

今回はIEを生成し、DOM操作を行い、HTMLから値を取得するので以下の参照設定を追加します。

デフォルト参照設定

  • Visual Basic For Applications
  • Microsoft Excel **.* Object Library
  • OLE Automation
  • Microsoft Office **.* Object Library

追加参照設定

  • Microsoft HTML Object Library
  • Microsoft Innternet Controls
参照設定の追加
２つの参照にチェックを入れ「OK」を押すと参照が追加されます。

サンプル

サンプルファイルのダウンロード
header モジュール

Option Explicit

''' Sleep
#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

''' IE image download
Public 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

image_download モジュール

''' 参照追加
'''     Microsoft HTML Object Library
'''     Microsoft Innternet Controls
'''

Option Explicit

Sub main()

'
' WS 設定値
'
Dim save_path As String
Dim get_url As String
Dim size_min As String
Dim size_max As String

' WS 設定取得
With ActiveSheet
    get_url = .Range("B5").Value
    save_path = .Range("B8").Value
    size_min = .Range("B11").Value
    size_max = .Range("F11").Value
End With

' WS 設定確認
If "" = Trim(get_url) Then
    MsgBox ("画像を取得するページURLを入力してください。")
    Exit Sub
End If
If "" = Trim(save_path) Then
    save_path = ThisWorkbook.Path
End If
If "\" <> Right(save_path, 1) Then
    save_path = save_path & "\"
End If
If "" = Trim(size_min) Then
    size_min = 0
End If
If "" = Trim(size_max) Then
    size_max = 999999999
End If
If Dir(save_path, vbDirectory) = "" Then
    ' 保存先フォルダがない
    MsgBox ("保存先のフォルダがありません。")
    Exit Sub
End If

'
' 処理開始
'
Dim ie As InternetExplorer
Dim img As HTMLImg
Dim src As String
Dim ary1, ary2
Dim name As String
Dim ret As Long

Dim count_saccess As Long
    count_saccess = 0
Dim error_saccess As Long
    error_saccess = 0

' IE 生成
Set ie = CreateObject("InternetExplorer.Application")
With ie
    ' IE 可視化
    .Visible = True
    ' IE 取得用URL
    .navigate get_url

    ' IE ページ表示待機
    Sleep 1000
    Do
        Sleep 300
        DoEvents
    Loop Until (Not .Busy) And (.readyState = 4)
    Sleep 1000

    ' IE ページ内 全imgタグ
    For Each img In .document.getElementsByTagName("img")
        ' IMG 画像URL
        src = img.src
        ' IMG パラメーター削除
        ary1 = Split(src, "?")
        ' IMG ファイル名取得
        ary2 = Split(ary1(0), "/")
        name = ary2(UBound(ary2))
        ' IMG 拡張子なしは 強制jpg
        If Not 0 < InStr(name, ".") Then
            name = name & ".jpg"
        End If

        ' IMG 指定サイズで絞込み
        If size_min < img.Height And size_min < img.Width And _
            size_max > img.Height And size_max > img.Width Then
            ' IMG 画像ダウンロード
            ret = URLDownloadToFile(0, src, save_path & name, 0, 0)
            If ret = 0 Then
                ' ダウンロード成功
                count_saccess = count_saccess + 1
            Else
                ' ダウンロード失敗
                error_saccess = error_saccess + 1
            End If
        End If
    Next img
    .Quit
End With
Set ie = Nothing

' ダウンロード 結果表示
MsgBox ("ダウンロード数 : " & count_saccess & vbCrLf & "エラー数 : " & error_saccess)

End Sub

プログラムの説明

header モジュール

''' IE image download
Public 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
URLDownloadToFile宣言
pCaller 0
szURL ファイルのURLを渡します
szFileName ローカルに保存する際の画像パスを渡します
dwReserved 0
lpfnCB 0

「URLDownloadToFile」は、「ダウンロードしたいファイルのURL」と、「保存する場所＋名前」を指定して、WEB上のファイルをダウンロードするWindwosAPIです。
戻り値は「0」ならダウンロードの完了、それ以外ならダウンロードの失敗となります。

image_download モジュール

' WS 設定確認
If "" = Trim(get_url) Then
    MsgBox ("画像を取得するページURLを入力してください。")
    Exit Sub
End If
If "" = Trim(save_path) Then
    save_path = ThisWorkbook.Path
End If
If "\" <> Right(save_path, 1) Then
    save_path = save_path & "\"
End If
If "" = Trim(size_min) Then
    size_min = 0
End If
If "" = Trim(size_max) Then
    size_max = 999999999
End If
If Dir(save_path, vbDirectory) = "" Then
    ' 保存先フォルダがない
    MsgBox ("保存先のフォルダがありません。")
    Exit Sub
End If
入力されている値を確認します。
「画像取得ページ URL」は空欄禁止。
「保存先」が空欄の場合は、ThisWorkbook.Path（エクセル自身のパス）を指定。
「保存先」の最後の文字が「\」（区切り文字）でなかった場合は、区切り文字の追加。
「取得画像サイズ」が空欄の場合は、最小と最大に値をセット。
最後に「保存先」で指定されたフォルダが存在するかを、Dir関数を用いて確認し、存在しない場合は終了します。
Set ie = CreateObject("InternetExplorer.Application")
With ie
    ' IE 可視化
    .Visible = True
    ' IE 取得用URL
    .navigate get_url
IEを生成して、指定したページを表示します。
' IE ページ内 全imgタグ
For Each img In .document.getElementsByTagName("img")
ページ内になる全ての画像タグをループして取得していきます。
' IMG 画像URL
src = img.src
' IMG パラメーター削除
ary1 = Split(src, "?")
' IMG ファイル名取得
ary2 = Split(ary1(0), "/")
name = ary2(UBound(ary2))
' IMG 拡張子なしは 強制jpg
If Not 0 < InStr(name, ".") Then
    name = name & ".jpg"
End If
画像パスから、ローカルに保存する際のファイル名を取得します。
http://localhost.org/img/(filename.jpg)?p=1
上記のようなパスだった場合、カッコ内がファイル名となります。
稀にある拡張子のない画像は、強制的に「jpg」として保存します。
' IMG 指定サイズで絞込み
If size_min < img.Height And size_min < img.Width And _
	size_max > img.Height And size_max > img.Width Then
指定画像サイズに満たさないものを除外します。
指定値は、高さ、幅、両方に適応されます。
高さ（Height）または幅（Width）片方だけで絞り込みたい場合は、不要な方を削除してください。
' IMG 画像ダウンロード
ret = URLDownloadToFile(0, src, save_path & name, 0, 0)
「URLDownloadToFile」を使用して画像を取得します。
成功した場合は「ret」に「0」が格納されます。

まとめ

サンプルファイルのダウンロード
今回は画像をダウンロードしてローカルに保存する方法について、サンプルをもとに解説しました。

今回のサンプルでは、IEを生成してから画像を取得しましたが、「WinHttpRequest」などで取得したレスポンスから、画像タグを取得すれば、IEを開く手間と時間が省略出来ます。
また、取得したい画像のURLが決まっている場合は、Forループなどで「URLDownloadToFile」に直接画像URLを渡せば、さらに時間の短縮が出来ると思います。
※ ダウンロードした画像を無許可で公開してしまうと著作権に触れる可能性があるのでご注意ください。
※ 本プログラムを利用しために被る損害について、当社に故意または重大な過失がある場合を除き、当社は一切その責任を負いません。


プログラムの開発、お見積り、お問い合わせは、こちらから、ご連絡ください。
まだ仕様の決まっていない場合のご相談などもお気軽にご相談ください。
prev
blog top
contact
contact