画像ファイルをダウンロード（保存）する

画像を保存（ダウンロード）するサンプルコードです。標準モジュールに以下のコードを追加し、DownloadImageサブプロシージャを実行します。 ImageDownloadサブプロシージャを実行すると、IEを起動してこのページに接続し、以下の画像（guam.jpg）をPCのマイドキュメントフォルダに保存します。 guam

サンプルコード

【動作確認日】2014年5月19日
【動作確認環境】Windows 7・Excel 2010・Internet Explorer 11

'定数の宣言
Private Const S_OK = &H0
Private Const CSIDL_PERSONAL = &H5
Private Const MAX_PATH = 260
 
'API宣言
Private Declare Function SHGetFolderPath Lib "shfolder" _
    Alias "SHGetFolderPathA" _
    (ByVal hwndOwner As Long, ByVal nFolder As Long, _
    ByVal hToken As Long, ByVal dwFlags As Long, _
    ByVal pszPath As String) As Long

Private Declare Function DeleteUrlCacheEntry Lib "wininet" _
    Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
    
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 DownloadImage()
    Dim objIE As Object
    Dim objImg As Object
 
    Dim myDocumentsFolder As String
    Dim result As Integer
 
    'マイドキュメントフォルダのパスを取得
    myDocumentsFolder = String(MAX_PATH, vbNullChar)
    result = SHGetFolderPath(0, CSIDL_PERSONAL, 0, 0, myDocumentsFolder)
    myDocumentsFolder = Left(myDocumentsFolder, InStr(1, myDocumentsFolder, Chr(0)) - 1)
    myDocumentsFolder = myDocumentsFolder + ""
 
    'IE起動
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Visible = True
 
    'URLに接続
    objIE.navigate "https://vba-code.net/ie/download-image/"
 
    'IEを待機
    Call IEWait(objIE)
 
    '3秒停止
    Call WaitFor(3)
    
    '画像ファイルのオブジェクトを取得
    Set objImg = objIE.Document.getElementsByTagName("img")(0)
    
    'キャッシュを削除
    result = DeleteUrlCacheEntry(objImg.href)
 
    '画像をダウンロード
    result = URLDownloadToFile(0, objImg.href, myDocumentsFolder + objImg.Nameprop, 0, 0)
    
    'IE終了
    objIE.Quit
 
    Set objIE = Nothing
End Sub
 
'IEを待機する関数
Function IEWait(ByRef objIE As Object)
    Do While objIE.Busy = True Or objIE.readyState <> 4
        DoEvents
    Loop
End Function
 
'指定した秒だけ停止する関数
Function WaitFor(ByVal second As Integer)
    Dim futureTime As Date
 
    futureTime = DateAdd("s", second, Now)
    While Now < futureTime
       DoEvents
    Wend
End Function

'定数の宣言

Private Const S_OK = &H0

Private Const CSIDL_PERSONAL = &H5

Private Const MAX_PATH = 260

'API宣言

Private Declare Function SHGetFolderPath Lib "shfolder" _

Alias "SHGetFolderPathA" _

(ByVal hwndOwner As Long, ByVal nFolder As Long, _

ByVal hToken As Long, ByVal dwFlags As Long, _

ByVal pszPath As String) As Long

Private Declare Function DeleteUrlCacheEntry Lib "wininet" _

Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long

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 DownloadImage()

Dim objIE As Object

Dim objImg As Object

Dim myDocumentsFolder As String

Dim result As Integer

'マイドキュメントフォルダのパスを取得

myDocumentsFolder = String(MAX_PATH, vbNullChar)

result = SHGetFolderPath(0, CSIDL_PERSONAL, 0, 0, myDocumentsFolder)

myDocumentsFolder = Left(myDocumentsFolder, InStr(1, myDocumentsFolder, Chr(0)) - 1)

myDocumentsFolder = myDocumentsFolder + ""

'IE起動

Set objIE = CreateObject("InternetExplorer.Application")

objIE.Visible = True

'URLに接続

objIE.navigate "https://vba-code.net/ie/download-image/"

'IEを待機

Call IEWait(objIE)

'3秒停止

Call WaitFor(3)

'画像ファイルのオブジェクトを取得

Set objImg = objIE.Document.getElementsByTagName("img")(0)

'キャッシュを削除

result = DeleteUrlCacheEntry(objImg.href)

'画像をダウンロード

result = URLDownloadToFile(0, objImg.href, myDocumentsFolder + objImg.Nameprop, 0, 0)

'IE終了

objIE.Quit

Set objIE = Nothing

End Sub

'IEを待機する関数

Function IEWait(ByRef objIE As Object)

Do While objIE.Busy = True Or objIE.readyState <> 4

DoEvents

Loop

End Function

'指定した秒だけ停止する関数

Function WaitFor(ByVal second As Integer)

Dim futureTime As Date

futureTime = DateAdd("s", second, Now)

While Now < futureTime

DoEvents

Wend

End Function

解説

このサンプルでは3つのAPIを使用しています。APIを使用するために、サブプロシージャの上に各APIの宣言を記述しています。DownloadImageプロシージャの中では、ず、SHGetFolderPathでマイドキュメントフォルダのパスを取得しています。

画像をダウンロードするための準備として、DeleteUrlCacheEntryでキャッシュを削除しています。このキャッシュを削除する処理は必須ではありませんが、確実に新しいファイルを取得するにはこのAPIを使います。

そして最後にURLDownloadToFileで画像をダウンロードしています。URLDownloadToFileは、指定したURLのファイルを保存するAPIです。もちろん画像ファイルだけでなく、PDFファイルなど他のファイルもダウンロード可能です。

一つ補足です。URLが最初からわかっているのなら、IEオブジェクトを生成する必要はありません。決め打ちのURLとファイル名をURLDownloadToFileにそのまま渡せばいいだけです。IEオブジェクトを使わない簡略化したバージョンは以下になります。IEオブジェクトを生成する必要がないので、ダウンロードは一瞬で終わります。

IEオブジェクトを使わないバージョン

'定数の宣言
Private Const S_OK = &H0
Private Const CSIDL_PERSONAL = &H5
Private Const MAX_PATH = 260
 
'API宣言
Private Declare Function SHGetFolderPath Lib "shfolder" _
    Alias "SHGetFolderPathA" _
    (ByVal hwndOwner As Long, ByVal nFolder As Long, _
    ByVal hToken As Long, ByVal dwFlags As Long, _
    ByVal pszPath As String) As Long
 
Private Declare Function DeleteUrlCacheEntry Lib "wininet" _
    Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
    
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 SimpleDownloadImage()
    Dim Rtn_Down As Integer
    Dim Rtn_del As Integer
    Dim myDocumentsFolder As String
    Dim result As Integer
    
    Const imgUrl As String = "https://vba-code.net/ie/download-image/"
    Const fileName As String = "guam.jpg"
 
    'マイドキュメントフォルダのパスを取得
    myDocumentsFolder = String(MAX_PATH, vbNullChar)
    result = SHGetFolderPath(0, CSIDL_PERSONAL, 0, 0, myDocumentsFolder)
    myDocumentsFolder = Left(myDocumentsFolder, InStr(1, myDocumentsFolder, Chr(0)) - 1)
    myDocumentsFolder = myDocumentsFolder + ""
     
    'キャッシュを削除
    result = DeleteUrlCacheEntry(imgUrl)
 
    '画像をダウンロード
    result = URLDownloadToFile(0, imgUrl, myDocumentsFolder + fileName, 0, 0)
End Sub