質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.91%

エクセルVBA IE 画像取得。指定のタグの中の画像のみをダウンロードしたい

受付中

回答 0

投稿

  • 評価
  • クリップ 0
  • VIEW 186

pythonbegginer

score 23

VBA詳しい方どうか教えて頂けると嬉しいです。

★やりたいこととして、指定URLの画像を取得したいのですが全部ではなく一部だけやりたいのですがやり方がわかりません(>_<)

例として、ホットペッパーのこのお店の全部の写真ではなく、添付画像の写真のみ(画像は何枚かあります)をダウンロードしてみてるのですが、全写真がダウンロードされてしまいます。店舗はランダムです。[こちら](https://www.hotpepper.jp/strJ00イメージ説明0/)

イメージ説明

ネットで検索したコードを使用しているのですが、たぶんここを変えないといけないのかな。。とは思うのですが、、どうしたらいいか全くわからずで教えてほしいです。。

' IE ページ内 全imgタグ
For Each img In .document.getElementsByTagName("img")

全コードは以下です。

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

' Debug.Print img.Height
' Debug.Print img.Width
' Debug.Print name

' 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


参考にしたサイトはこちらです。

どうかよろしくお願いいたします。

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

まだ回答がついていません

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.91%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る