画像をDLするコードが動かない
こんにちは。
秀和システムのVBAでIEを操作する書籍で解説されている、WEBサイトから画像データをDLするというコードが動かず困っています。
コードは以下です。
Range("Sheet1!$b$1") に、秀和システムの公式サイトのURLが記載されています。
-----ここから-----
Dim obIE As Object '変数の定義を行います
Dim Obj As Object '変数の定義を行います
Dim Rtn_Down As Integer '変数の定義を行います
Dim Rtn_del As Integer '変数の定義を行います
'「Sleep」コマンドを使う場合の決まり文句
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'「URLDownloadToFile」を使う場合の決まり文句
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
'「DeleteUrlCacheEntry」を使う場合の決まり文句
Declare Function DeleteUrlCacheEntry Lib "wininet" _
Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
Sub ファイルをダウンロード()
Set obIE = CreateObject("InternetExplorer.Application") '変数の定義を行います
obIE.Visible = True '決まり文句。IEを見えるようにします
Range("Sheet1!$b$1").Hyperlinks(1).Follow NewWindow:=True '画像を取得したいページを新しいウィンドウで開きます
Sleep (2000)
' Do While obIE.ReadyState <> 4 '決まり文句。サイトが開くまで待ちます
Do While obIE.Busy = True '決まり文句。サイトが開いてなければ、繰り返し待ちます
Loop
' Loop
For Each Obj In obIE.document.images '表示されているサイトのイメージタグを一つずつ、変数objにセット
Rtn_del = DeleteUrlCacheEntry(Obj.href) 'ダウンロード対象のキャッシュをクリアします
Rtn_Down = URLDownloadToFile(0, Obj.href, "c:\test\" + Obj.Nameprop, 0, 0)
'ファイルをCドライブのtestというフォルダにダウンロード
Next '次のタグを処理します
End Sub
-----ここまで-----
F8でステップ実行すると、
Do While obIE.ReadyState <> 4 '決まり文句。サイトが開くまで
待ちます
Do While obIE.Busy = True '決まり文句。サイトが開いてな
ければ、繰り返し待ちます
Loop
Loop
のところでずっとループをくり返している、というところまでは突き止めましたが、どうやって解決したら良いか判らずにいます。
また、
ためしに、
Do While obIE.ReadyState <> 4 '決まり文句。サイトが開くまで
待ちます
をコメントアウトしたところ、先に進みましたが、
For Each Obj In obIE.document.images '表示されてい
るサイトのイメージタグを一つずつ、変数objにセット
のところで、
「実行時エラー '-2147467259(80004005)':
'Document'メソッドは失敗しました: 'IWebBrouser2'オブジェクト
というエラーが発生しました。
どなたかアドバイスの程、なにとぞお願い致します。
（なお、自分で入力したコードがダメだったあと、公式サイトからサンプルコードをDLして試しましたが、結果は同じでした）
お礼
ありがとうございます！