VBAでボタンを押すと指定サイトの画像抽出

質問

お力を貸してください。
エクセルVBAで、テキストボックスとボタンを配置しました。

テキストボックス内にURLを入れてボタンを押すと、指定サイトに表示されている
すべての画像を抽出して、エクセルに貼り付けるVBAを作りたいのですが、どのようなソースにすればよいでしょうか？

教えて頂けたら幸いです。

よろしくお願いいたします。

回答No.2

ushi2015 · ベストアンサー

こんにちは
Sub test1()
　　Dim oIE As Object
　　Dim e As Object
　　Dim i As Long
　　Dim j As Long
　　ActiveSheet.DrawingObjects.Delete
　　Rows.RowHeight = 140
　　Columns.ColumnWidth = 40
　　Set oIE = CreateObject("InternetExplorer.Application")
　　oIE.Visible = True
　　oIE.navigate "https://pro.foto.ne.jp/free/products_list.php/cPath/21_28_71"
　　Do While oIE.Busy Or oIE.ReadyState <> 4
　　　　DoEvents
　　Loop
　　Range("A1").Select
　　i = 1: j = 1
　　For Each e In oIE.Document.getElementsByTagName("img")
　　　　If LCase(e.nameProp) Like "*.jpg" _
　　　　　　Or LCase(e.nameProp) Like "*.png" Then
　　　　　　Cells(i, j).Select
　　　　　　ActiveSheet.Pictures.Insert e.href
　　　　　　If j = 2 Then
　　　　　　　　i = i + 1
　　　　　　End If
　　　　　　If j = 1 Then
　　　　　　　　j = 2
　　　　　　Else
　　　　　　　　j = 1
　　　　　　End If
　　　　End If
　　Next
　　oIE.Quit
End Sub
こんな感じで。

お礼

大変ありがとうございました。
やりたい内容がすべてできました。
すばらしいコードを参考にさせていただきます。
ありがとうございました

回答No.3

chie65536（@chie65535）

横から失礼します。

＞（１）jpg だけじゃなく　jpg と png にも対応できるようにしたい
＞（２）画像の表示を縦に１列の出力ではなく２列の出力にしたい

ご要望にお答えして改造してみました。

Sub test()
Dim oIE As Object
Dim e As Object
Dim f As String
ActiveSheet.DrawingObjects.Delete
Set oIE = CreateObject("InternetExplorer.Application")
oIE.Visible = True
oIE.navigate "https://pro.foto.ne.jp/free/products_list.php/cPath/21_28_71"
Do While oIE.Busy Or oIE.ReadyState <> 4
DoEvents
Loop
Range("A1").Select
For Each e In oIE.Document.getElementsByTagName("img")
f = LCase(e.nameProp)
If (f Like "*.jpg") Or (f Like "*.jpeg") Or (f Like "*.png") Then
ActiveSheet.Pictures.Insert e.href
If ActiveCell.RowHeight < e.Height * 0.75 Then
ActiveCell.RowHeight = e.Height * 0.75
End If
If ActiveCell.ColumnWidth < e.Width * 0.1188 Then
ActiveCell.ColumnWidth = e.Width * 0.1188
End If
If ActiveCell.Column = 1 Then
ActiveCell.Offset(0, 1).Select
Else
ActiveCell.Offset(1, -1).Select
End If
End If
Next
oIE.Quit
End Sub

セルの幅と高さも、画像に合わせて調整するようにしてみました。

但し「オリジナル画像の幅や高さが、imgタグでのWidthやHeightと異なっている場合」には、セルの幅と高さの調整に失敗します（imgタグでのWidthやHeightの指定を「画像の大きさ」だと思って処理してしまうため。オリジナルの画像の大きさをVBAで拾う事はできません）

回答No.1

ushi2015

こんにちは
Sub test()
　　Dim oIE As Object
　　Dim e As Object
　　ActiveSheet.DrawingObjects.Delete
　　Rows.RowHeight = 100
　　Set oIE = CreateObject("InternetExplorer.Application")
　　oIE.Visible = True
　　oIE.navigate "https://pro.foto.ne.jp/free/products_list.php/cPath/21_28_71"
　　Do While oIE.Busy Or oIE.ReadyState <> 4
　　　　DoEvents
　　Loop
　　Range("A1").Select
　　For Each e In oIE.Document.getElementsByTagName("img")
　　　　If LCase(e.nameProp) Like "*.jpg" Then
　　　　　　ActiveSheet.Pictures.Insert e.href
　　　　　　ActiveCell.Offset(1, 0).Select
　　　　End If
　　Next
　　oIE.Quit
End Sub
こんな感じとか。

補足

早速のご回答ありがとうございます。
こちらがやりたいことがほとんどできてる状態ですごくうれしく感じております。

１点わかれば追加で教えていただきたいのですが、
（１）jpg だけじゃなく　jpg と png にも対応できるようにしたい
（２）画像の表示を縦に１列の出力ではなく２列の出力にしたい
のですが、こんなことは可能でしょうか？

よろしくお願いいたします。