適材適所

パソコン作業の自動化・効率化のための情報を発信するブログ(VBA,PowerShellなど)

VBAでウェブスクレイピング_WinHTTP編その5

この記事では

WinHTTPで画像をダウンロードするためには

VBAで画像をダウンロードするために必要な情報はHTMLの中にあります。 (HTMLのわかりやすい解説はネット上に沢山あるのでここでは述べません。悪しからず。)

ダウンロードしたいページのHTMLさえ取得できれば、その中に画像のURLが記載されています。

WinHTTPで画像をダウンロードするために必要なのは、HTMLを解析して画像のURLを集めることです。

その1で実例を紹介した通りWinHTTPを使うと、生のHTMLがすぐに取得できます。 HTML内のimgタグの「src」こそが画像のファイル名になります。

f:id:shinmai_papa:20190913201840p:plainがHTML上でどのようになっているか見てみると・・・

<img src="https://cdn.profile-image.st-hatena.com/users/shinmai_papa/profile.png?1567396351" alt="id:shinmai_papa" class="profile-icon">

となっています。

試しに上記のhttps://~をクリックしてみると、ブラウザに画像が表示されます。

WinHTTPでも同じになります。

WinHTTPで画像ダウンロードするためには、HTMLの中から欲しい画像のsrc部分を見つけ出し、リクエストをサーバに送ってあげればいいのです。

WinHTTPで画像をダウンロードするサンプルを作成する

画像をダウンロードするツールも世の中にはたくさんありますが、自分で作れると自由度が各段にあがります。 VBAならOffice製品があればインストール作業は不要ですからね。

今回はサンプルとして特定のウェブページ上にある画像データをWinHTTPで一括で保存するサンプルを作成してみます。

下記のコードのうち、urlと保存先フォルダを任意のものに変更して実行すると画像が保存されます。

コード

実行前に参照設定を行います。 Microsoft WinHTTP Services, version○.〇 Microsoft HTML Object Library

Sub WinHTTP_sample()
   Dim req As WinHttp.WinHttpRequest: Set req = New WinHttp.WinHttpRequest
   Dim url As String
   url = "https://〇〇〇"
   req.Open "GET", url

   req.Send

   If req.Status <> 200 Then
      MsgBox "ステータスエラー"
      Exit Sub
   End If

   Dim urls As Collection: Set urls = New Collection
   Set urls = getUrls(req.ResponseText)

   Dim i As Long
   Dim extension As String
   For i = 1 To urls.Count
      Set req = New WinHttp.WinHttpRequest
      On Error Resume Next
      req.Open "GET", urls(i)
      req.Send
      extension = getExtension(urls(i))
      writeBinary req.ResponseBody, "C:\sample\" & i & "." & extension
      On Error GoTo 0
   Next i
End Sub

Function getUrls(body As String) As Collection
   Dim html As Object: Set html = New HTMLDocument
   html.Write body
   Dim returnColl As Collection: Set returnColl = New Collection
   Dim image As HTMLImg
   For Each image In html.getElementsByTagName("img")
      returnColl.Add image.src
   Next image
   Set getUrls = returnColl
End Function

Sub writeBinary(ByVal varByte As Variant, fPath As String)
   Dim byteLen As Long: byteLen = LenB(varByte)
   Dim buf() As Byte: ReDim buf(byteLen)
   buf = varByte
   Dim freeNum As Long: freeNum = FreeFile
   Open fPath For Output As #freeNum
   Close freeNum
   Open fPath For Binary Access Write As #freeNum
      Put #freeNum, 1, buf
   Close freeNum
End Sub

Function getExtension(url As String) As String
   Dim posi As Long: posi = InStrRev(url, ".")
   getExtension = Mid(url, posi + 1)
End Function

コードの解説

基本的な考え方は、「要求をオープンして送る」です。

7行目で、要求した結果のHTMLから、getUrls関数というヘルパー関数によってimgタグのsrc属性をコレクションとして得ています。
19行目のループで、各src属性のURLにWinHTTPを使って要求を送っています。

枠組みとしてはこれだけです。

writeBinaryというヘルパープロシージャは少しわかりづらいですが、レスポンスの中身をファイルに保存する処理です。

writeBinaryの中では、WinHttpRequest# ResponseBodyが、応答本文をバイト配列で読み取りできることから、それをバイト配列に格納してファイルに書き込んでいます。

VBAではあまり扱う機会がないかもしれないバイト列を扱うアイディアです。

getExtension関数は拡張子を得るための関数です。
これまたあまり使う機会のないかも知れない、InStrRev関数を使っています。
これは、第2引数の文字列を右から探索して、第3引数の文字列が最初に現れる位置を返す関数です(第1引数は省略されています)。

WinHTTP以外のところが少しややこしいですが、VBAで画像を一括ダウンロードすることができました。

おわりに

WinHTTPを使った画像の一括ダウンロードプログラムを作ってみました。
これを応用すれば、VBAを使ってウェブ上のHTMLと画像を収集するプログラムも簡単に作ることができるかと思います。
次回は、フォームの送信なんかを見ていきたいと思います。

ここまでお読みいただき、ありがとうございました。

参考サイト

WinHttpRequest object - Windows applications | Microsoft Docs 【VBA】Openステートメントでバイナリファイルを読み書きする | やさしいプログラミング備忘録