Document.Images で イメージのオブジェクトにアクセスできたので、
Dim objIMG As HTMLImg 'イメージ、図
と変数を宣言してから、下記のループで1つ1つ取り出し使ってみました。
For n = 0 To objDOC.images.Length - 1 'イメージ数ループする。
Set objIMG = objDOC.images(n) 'n番目のイメージを代入
↑あとは、それっぽい、プロパティを書き出してみました。
.src が URL で .Titleが呼んで字のごとくタイトルでした。
サンプルを動かしながら、確認してみてください。
下記、サンプルです。Excel2003 OS:XP SP3 IE8 でテストしました。
まずは、実行して遊んでみてください。
'参照設定 Microsoft Internet Controls(Microsoft Browser Helpers)
'Microsoft HTML Object Library の 2つを忘れずに
'参照設定の方法は、 http://www.ken3.org/cgi-bin/group/vba_ie_object.asp をみてください。
Sub ie_test_img_list() 'イメージ 画像のリスト 一覧を作る
'目的のURLを入力する。(URLを指定する)
Dim strURL As String 'URL入力用
strURL = InputBox("URLを指定", "URL入力", "http://ie.vba-ken3.jp/test/")
'結果表示エリアをクリア
Rows("6:999").Delete Shift:=xlUp
'IEのオブジェクトを新規で作り、表示サイズと場所を調整する。
Dim objIE As InternetExplorer 'IEオブジェクト参照用
Set objIE = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
objIE.Visible = True '見えるようにする(お約束)
'IE 画面サイズの調整(表示場所とサイズ)
objIE.FullScreen = False '= Trueで最大化します。
objIE.Top = 200 '左上 Y 表示場所の指定
objIE.Left = 100 '左上 X
objIE.Width = 800 '横の幅
objIE.Height = 600 '縦の高さ
'目的のページを表示する
'指定したページを表示
objIE.navigate strURL '文字列でURLを渡す
'表示完了を待つ .readyState と .Busy を見る
While objIE.readyState <> READYSTATE_COMPLETE Or objIE.Busy = True 'IEがBusyの間 待つ
DoEvents
Wend
DoEvents
'表示されたHTML文章 ドキュメント にアクセスして、画像の情報をセルに書き込む
Dim n As Integer 'n番目のカウンター変数
Dim y As Integer 'Y行目のカウンター変数
'ドキュメント、HTML文章にアクセスする
Dim objDOC As HTMLDocument
Set objDOC = objIE.document 'IEの文章をセット
Range("A6") = "URL = " & objDOC.URL
Range("A7") = "ページのタイトルは = " & objDOC.Title
'イメージ、画像を探る
Dim objIMG As HTMLImg 'イメージ、図
y = 10
Cells(y, "A") = "images.Length は(イメージの数は) " & objDOC.images.Length
y = y + 1
'見出しを付ける。
Cells(y, "A") = "no(n番目)"
Cells(y, "B") = "'.src (URL)" 'URL
Cells(y, "C") = "'.Title" 'タイトル
Cells(y, "D") = "'.outerHTML" 'HTML
y = y + 1
'イメージを1つ1つ取り出し、処理する。
For n = 0 To objDOC.images.Length - 1 'イメージ数ループする。
Set objIMG = objDOC.images(n) 'n番目のイメージを代入
Cells(y, "A") = n
Cells(y, "B") = "'" & objIMG.src 'URL
Cells(y, "C") = "'" & objIMG.Title 'タイトル
Cells(y, "D") = "'" & objIMG.outerHTML 'HTML
y = y + 1 '次の行へ
Next
'後始末
'終了処理 テストの時は、↓確認して、残しておくと便利ですよ。
If MsgBox("IEを閉じますか?", vbYesNo) = vbYes Then '終了確認
objIE.Quit '.Quitで閉じる
End If
'使用したオブジェクト変数もキレイにしてね。
Set objIMG = Nothing
Set objDOC = Nothing
Set objIE = Nothing
End Sub
'URLDownloadToFile API from URLMON.
Private 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
'↑ソースの一番上に宣言文を書き込んでください。
Sub ie_test_img_download() 'イメージ 画像のリスト 一覧を作り ダウンロード
'目的のURLを入力する。(URLを指定する)
Dim strURL As String 'URL入力用
strURL = InputBox("URLを指定", "URL入力", "http://ie.vba-ken3.jp/test/")
'結果表示エリアをクリア
Rows("6:999").Delete Shift:=xlUp
'IEのオブジェクトを新規で作り、表示サイズと場所を調整する。
Dim objIE As InternetExplorer 'IEオブジェクト参照用
Set objIE = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
objIE.Visible = True '見えるようにする(お約束)
'IE 画面サイズの調整(表示場所とサイズ)
objIE.FullScreen = False '= Trueで最大化します。
objIE.Top = 200 '左上 Y 表示場所の指定
objIE.Left = 100 '左上 X
objIE.Width = 800 '横の幅
objIE.Height = 600 '縦の高さ
'目的のページを表示する
'指定したページを表示
objIE.navigate strURL '文字列でURLを渡す
'表示完了を待つ .readyState と .Busy を見る
While objIE.readyState <> READYSTATE_COMPLETE Or objIE.Busy = True 'IEがBusyの間 待つ
DoEvents
Wend
DoEvents
'表示されたHTML文章 ドキュメント にアクセスして、画像の情報をセルに書き込む
Dim n As Integer 'n番目のカウンター変数
Dim y As Integer 'Y行目のカウンター変数
'ドキュメント、HTML文章にアクセスする
Dim objDOC As HTMLDocument
Set objDOC = objIE.document 'IEの文章をセット
Range("A6") = "URL = " & objDOC.URL
Range("A7") = "ページのタイトルは = " & objDOC.Title
'イメージ、画像を探る
Dim objIMG As HTMLImg 'イメージ、図
y = 10
Cells(y, "A") = "images.Length は(イメージの数は) " & objDOC.images.Length
y = y + 1
'見出しを付ける。
Cells(y, "A") = "no(n番目)"
Cells(y, "B") = "'.src (URL)" 'URL
Cells(y, "C") = "'.Title" 'タイトル
Cells(y, "D") = "'.outerHTML" 'HTML
y = y + 1
'イメージを1つ1つ取り出し、処理する。
For n = 0 To objDOC.images.Length - 1 'イメージ数ループする。
Set objIMG = objDOC.images(n) 'n番目のイメージを代入
Cells(y, "A") = n
Cells(y, "B") = "'" & objIMG.src 'URL
Cells(y, "C") = "'" & objIMG.Title 'タイトル
Cells(y, "D") = "'" & objIMG.outerHTML 'HTML
'ダウンロード処理を呼ぶ
Call get_url_file(objIMG.src) 'URLを渡す
y = y + 1 '次の行へ
Next
'後始末
'終了処理 テストの時は、↓確認して、残しておくと便利ですよ。
If MsgBox("IEを閉じますか?", vbYesNo) = vbYes Then '終了確認
objIE.Quit '.Quitで閉じる
End If
'使用したオブジェクト変数もキレイにしてね。
Set objIMG = Nothing
Set objDOC = Nothing
Set objIE = Nothing
End Sub
'URLを受け取り、ファイルをダウンロードする
'関数内でURLからファイル名を作成する(/を探す)
' 詳細は http://www.ken3.org/vba/backno/vba120.html を見てください。
Sub get_url_file(strURL As String)
Dim strFNAME As String 'ダウンロード先(パス+ファイル名)
Dim strWORK As String '後ろから/を探し、ファイル名を取り出す
Dim returnValue
Dim n As Integer
'ファイル名を取り出す
For n = Len(strURL) To 1 Step -1 '後ろから/を探す
If Mid(strURL, n, 1) = "/" Then
Exit For '/が見つかったらループを抜ける
End If
Next n
strWORK = Mid(strURL, n + 1) '/の次からファイル名なのでn+1から
'ファイル名をブックのパス+\+取り出したファイル名とする
strFNAME = ThisWorkbook.Path & "\" & strWORK
'strFNAME = "C:\DATA\AAA\" & strWORK と固定のパスでもOKだけど
'URLDownloadToFile API をコールする
returnValue = URLDownloadToFile(0, strURL, strFNAME, 0, 0)
End Sub