VBAでWeb上のファイル(画像/動画/PDF)をダウンロードする方法【ServerXMLHTTP】
Windows APIのURLDownloadToFile関数を利用すると、指定した URL の画像を簡単にダウンロードできます。ただしこの関数が対応しているのは、いわゆる「固定パス」の URL にある画像ファイルに限られます。そのため、クエリパラメータ（?id=xxx など）が付与された「パラメータ付きURL」の画像には対応していません。そこで本記事では、パラメータ付きURLの画像もダウンロード可能な方法として、ServerXMLHTTPを利用する方法を解説していきます。
この方法は画像に限らず動画やPDF等のファイルのダウンロードにも有効です。
パラメータ付きURL：https://example.com/image.php?id=12345&size=large
ServerXMLHTTPオブジェクト
ServerXMLHTTPは、VBAから利用できる HTTP通信専用のオブジェクト です。このオブジェクトには、リクエストの送信やレスポンスの取得といった機能がひとまとめになっています。これを使うことで、指定したURLにアクセスしてHTMLを文字列として取得したり、アクセス先のデータをバイナリ形式で取得したりと、さまざまな処理を行うことができます。
ServerXMLHTTPオブジェクトはCreateObject関数を使って下記のようにすることで取得できます。
|
1 2 3 4 |
Dim oHTTP As Object Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0") |
このオブジェクトを使ってHTMLを文字列として取得する場合のサンプルコードは下記の通りです。
指定した URL に対してGETリクエストを送信することで、そのURLが持つ情報を取得できます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
Dim sHTML As String sHTML = GetHTML("https://www.example.com/") Debug.Print sHTML End Sub Public Function GetHTML(ByVal sURL As String) As String Dim oHTTP As Object Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0") 'GETリクエストを送信 Call oHTTP.Open("GET", sURL, False) Call oHTTP.setRequestHeader("User-Agent", "Mozilla/5.0") Call oHTTP.send '正常に応答があればHTMLを返す If oHTTP.Status = 200 Then GetHTML = oHTTP.responseText Else GetHTML = "Error: " & oHTTP.Status & " " & oHTTP.statusText End If End Function |
setRequestHeader を利用することで「このリクエストはどのような環境から送られたものか」といった追加情報を付与できます。特に”User-Agent”を設定しておくと、サーバーに対して「人間がブラウザからアクセスしたときと同じアクセスですよ」と伝えることができます。この指定がない場合、サーバー側で「機械からのアクセス」と判断され、接続を拒否されるケースがあるため、基本的には設定しておくことをおすすめします。(※WinAPIのURLDownloadToFile関数はこの設定ができません)
Web上の画像ダウンロード
ここでは指定したYouTubeのサムネイル画像をファイルとして保存するサンプルコードを紹介します。YouTubeのサムネイルは開発者ツールで確認するとパラメータ付きURになっているため例として取り上げていますが、コード中のURLを変えれば、基本的には他のサイトでも同じように利用できます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 |
Sub main() Dim sURL As String Dim sExt As String Dim sSaveDirPath As String Dim sFilePath As String Dim IsDownloaded As Boolean sURL = "https://i.ytimg.com/vi/przDcQe6n5o/hq720.jpg?sqp=-oaymwEnCNAFEJQDSFryq4qpAxkIARUAAIhCGAHYAQHiAQoIGBACGAY4AUAB&rs=AOn4CLAioX9ivuCIGyseh44BC59-qb9RYA" sSaveDirPath = "C:\...\images" '※保存先のフォルダパスに変更 sExt = ".jpg" If InStr(1, LCase$(sURL), ".png") > 0 Then sExt = ".png" If InStr(1, LCase$(sURL), ".webp") > 0 Then sExt = ".webp" sFilePath = sSaveDirPath & "\thumbnail" & sExt IsDownloaded = DownloadImageFile(sURL, sFilePath) If IsDownloaded Then Debug.Print "ダウンロード成功" Else Debug.Print "ダウンロード失敗 " End If End Sub '====================================================================== '= ダウンロード '====================================================================== Private Function DownloadImageFile(ByVal sURL As String, _ ByVal sFilePath As String) As Boolean Dim oHTTP As Object Dim oADO As Object Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0") On Error Resume Next Call oHTTP.Open("GET", sURL, False) Call oHTTP.setRequestHeader("User-Agent", "Mozilla/5.0") Call oHTTP.send If Err.Number <> 0 Then Exit Function On Error GoTo 0 If oHTTP.Status < 200 Or oHTTP.Status >= 300 Then Exit Function Set oADO = CreateObject("ADODB.Stream") With oADO .Type = 1 Call .Open Call .Write(oHTTP.responseBody) Call .SaveToFile(sFilePath, 2) .Close End With DownloadImageFile = True End Function |
上記コード内の下記部分が動画のサムネイル画像となっています。
|
1 2 3 |
sURL = "https://i.ytimg.com/vi/przDcQe6n5o/hq720.jpg?sqp=-oaymwEnCNAFEJQDSFryq4qpAxkIARUAAIhCGAHYAQHiAQoIGBACGAY4AUAB&rs=AOn4CLAioX9ivuCIGyseh44BC59-qb9RYA" |
対象は下記としており、URLにアクセスすればこの動画のサムネイルであることが確認できます。
コード解説
保存パスの動的生成
保存するディレクトリや名称を決めるために動的にファイルフルパスを生成します。このとき、指定のURLにどの拡張子が含まれているかを確認して保存するファイルの拡張子も決定しています。
|
1 2 3 4 5 6 |
sExt = ".jpg" If InStr(1, LCase$(sURL), ".png") > 0 Then sExt = ".png" If InStr(1, LCase$(sURL), ".webp") > 0 Then sExt = ".webp" sFilePath = sSaveDirPath & "\thumbnail" & sExt |
ここでは画像ファイルを前提としているので上記のようになっていますが、.mp4や.pdfなどの拡張子も設定すれば動画やPDFファイルの保存も行うことが可能になります。
GETリクエスト
指定のURLにアクセスして情報を取得する場合は、基本的には下記のコードになります。
|
1 2 3 4 5 6 7 |
Call oHTTP.Open("GET", sURL, False) Call oHTTP.setRequestHeader("User-Agent", "Mozilla/5.0") Call oHTTP.send If oHTTP.Status < 200 Or oHTTP.Status >= 300 Then Exit Function |
これにより取得した結果がServerXMLHTTPオブジェクト内に格納され、responseTextやresponseBodyで情報を参照することができます。ネットワークの関係や接続先のページが存在しないなどでうまく接続できなかった場合はStatusの値で判定することができます。
正常にアクセスできた場合は200番台の数字が格納されます。この値はHTTPステータスコードといい、一番有名なコードはページが見つからない時の「404」(https://liclog.net/存在しないページ)だと思います。HTTPステータスコードはServerXMLHTTPオブジェクト特有のものではなくどの言語でも共通のものなので、検索すれば各ステータスがどのような状態なのか簡単に確認することができます。
(参考： HTTPステータスコード – Wikipedia )
取得した情報をファイルに変換
指定のURLにアクセスして情報の取得ができたらresponseBodyでアクセス先ページの情報をバイナリデータとして取得することができます。そしてADODB.Streamを使うことで取得したバイナリデータをそのままファイルとして書き出す(変換する)ことができます。
|
1 2 3 4 5 6 7 8 9 10 |
Set oADO = CreateObject("ADODB.Stream") With oADO .Type = 1 Call .Open Call .Write(oHTTP.responseBody) Call .SaveToFile(sFilePath, 2) .Close End With |
Type=1はバイナリモードという指定をしており、順にOpenでストリームを開き、Writeで取得したバイナリデータをそのまま書き込み、そしてSaveToFileでファイルとして保存し、Closeでストリームを閉じるという流れになっています。ここは基本的にこの処理になるので定型文となります。