VBAでスクレイピングして画像をダウンロードしてシートに貼り付ける

Written on 土曜日, 4月 26th, 2008 at 20:30 by admin
Filed under VBAのお勉強.

http://q.hatena.ne.jp/1209185751

とりあえず、

Excelのシート上のボタンを押すと、指定したURLのページの天気の画像と、最高気温を取ってみたいと思います。

ここんとこよく取り上げてる「スクレイピング」ですね。

こないだやったのは、

VBAのお勉強　住所の文字列→緯度・経度を求める

これは文字から緯度・経度を取ってくる、ってものでした。

今回は、固定のページから指定した部分を抜き出してくる、ということで前よりは簡単そうです。

ただ、「画像を抜き出したい」とのことなので、それはこの前とはちょっと違いますね。

まず、HTMLのソースを取ってきてみます。

PLAIN TEXT
Visual Basic:
  1. Sub test()
  2.     Dim oHttp As Object
  3.     Set oHttp = CreateObject("MSXML2.XMLHTTP")
  4.     oHttp.Open "GET", "http://weather.livedoor.com/area/20/72.html", False
  5.     oHttp.Send
  6.     Debug.Print oHttp.responseText
  7. End Sub

こないだのYahoo!のトップを取ってくるのと同じですね。URLが違うだけです。

実行してみると、

ん、取れてるようです（＾＾）

天気と最高気温の部分はどこかな？

PLAIN TEXT
HTML:
  1. <table border="0" cellpadding="0" cellspacing="0" align="center" width="100%">
  3.     <td class="title"><small><strong>今日の天気</strong> - 4月26日(<font color='navy'>土</font>)</small></td>
  4. </tr>
  5. </table>
  6. <table border="0" cellpadding="0" cellspacing="0" align="center" width="100%" class="tableline">
  8.     <td rowspan="4" align="center" class="tdline" width="20%">
  9.     <div style="margin-bottom:5px;">
  10.     <img src="http://image.weather.livedoor.com/img/icon/10.gif" alt="曇時々雨"><br />
  11.     <small>曇時々雨</small>
  12.     </div>
  13.  
  14.     <table border="0" cellpadding="1" cellspacing="0">
  15.     <tr>
  16.         <td><span class="maxtemp"><small>最高気温</small></span></td>
  17.         <td><span class="maxtemp"><small>15℃</small></span></td>
  18.     </tr>
  19.  
  20.     <tr>
  21.         <td align="right"><span class="maxtemp"><small>前日差</small></span></td>
  22.         <td><span class="maxtemp"><small>(+3)</small></span></td>
  23.     </tr>

このあたりですね。

まず、簡単なほう、最高気温のほうから取ってみます。

ソースを見てみると、

<small>15℃</small>

の部分の「℃」の文字が一番最初に出てくるのが、この最高気温の部分のようです。

ということは、ソースの中から「℃」を探して、その前の数字の部分（>の後ろのから℃の前まで）が最高気温、ということになりそうです。

「℃」の位置を求めるには、いつものInstrでよさげです。

PLAIN TEXT
Visual Basic:
  1. Sub test()
  2.  
  3.     Dim oHttp As Object
  4.     Dim getSource As String
  5.  
  6.     Set oHttp = CreateObject("MSXML2.XMLHTTP")
  7.     oHttp.Open "GET", "http://weather.livedoor.com/area/20/72.html", False
  8.     oHttp.Send
  9.     getSource = oHttp.responseText
  10.  
  11.     Debug.Print InStr(getSource, "℃")
  12.  
  13. End Sub

実行してみると

実行するときの状況によって値は異なると思いますが、私が取り込んだ時点では7954文字目に「℃」があるようです。

次は、その前の 「>」の位置を調べなければいけないんですが。。。

「>」は、ソースの中にいっぱいありますから、単純に　Instr　では求められません。

この場合、後ろから文字を探す、InStrRevが使えそうです。

最初から「℃」までを抜き出した文字列を作り、その文字の後ろから「>」を探す、って感じですね。

PLAIN TEXT
Visual Basic:
  1. Sub test()
  2.  
  3.     Dim oHttp As Object
  4.     Dim getSource As String
  5.     Dim nukidashi As String
  6.     Dim saikoukion As String
  7.  
  8.     Set oHttp = CreateObject("MSXML2.XMLHTTP")
  9.     oHttp.Open "GET", "http://weather.livedoor.com/area/20/72.html", False
  10.     oHttp.Send
  11.     getSource = oHttp.responseText
  12.  
  13.     nukidashi = Mid(getSource, 1, InStr(getSource, "℃"))
  14.     Debug.Print InStrRev(nukidashi, ">")
  15.  
  16.     saikoukion = Mid(nukidashi, InStrRev(nukidashi, ">") + 1)
  17.     Debug.Print saikoukion
  18.  
  19. End Sub

nukidashiという変数に、先頭から「℃」までの文字列を代入して、

InStrRev(nukidashi, ">")　でnukidashiの後ろから「>」を探しています。

saikoukionに、「>」の次の文字以降の文字列を取ってくる、という風にしています。

実行してみると、

ん、取れました（＾＾）

後は、これをセルに代入すればいいですね。これは後でまとめてやります。

次、天気なんですけど。「画像を取りたい」ってことなので、流れとしては、画像をダウンロードして、

その画像をシートに貼り付ける、って感じでいいのかな？

まずソースの中から画像の部分を探してみます。

PLAIN TEXT
HTML:
  1. <table border="0" cellpadding="0" cellspacing="0" align="center" width="100%">
  3.     <td class="title"><small><strong>今日の天気</strong> - 4月26日(<font color='navy'>土</font>)</small></td>
  4. </tr>
  5. </table>
  6. <table border="0" cellpadding="0" cellspacing="0" align="center" width="100%" class="tableline">
  8.     <td rowspan="4" align="center" class="tdline" width="20%">
  9.     <div style="margin-bottom:5px;">
  10.     <img src="http://image.weather.livedoor.com/img/icon/10.gif" alt="曇時々雨"><br />
  11.     <small>曇時々雨</small>
  12.     </div>

この辺ですね。この「<img src=・・・・>」の部分を取ってくればいいんですが。

ソース全体でみれば、<img>タグは他にもいっぱいあるので、簡単には探せませんね。

ということで、この近辺をなんとか抜き出して、その中で<img>を抜き出す、ってことで。

全体のソースをみると、「今日の天気」という文字列は、この部分で初めて出てくるようです。

ということは、全体のソースから「今日の天気」を探し、そこ以降の文字列を抜き出し、その中で最初に出てくる<img>を抜き出せばよさげです。

こんな感じになります。

PLAIN TEXT
Visual Basic:
  1. Sub test()
  2.  
  3.     Dim oHttp As Object
  4.     Dim getSource As String
  5.     Dim nukidashi As String
  6.     Dim saikoukion As String
  7.  
  8.     Set oHttp = CreateObject("MSXML2.XMLHTTP")
  9.     oHttp.Open "GET", "http://weather.livedoor.com/area/20/72.html", False
  10.     oHttp.Send
  11.     getSource = oHttp.responseText
  12.  
  13.     '最高気温を取ってきます。
  14.     nukidashi = Mid(getSource, 1, InStr(getSource, "℃"))
  15.     saikoukion = Mid(nukidashi, InStrRev(nukidashi, ">") + 1)
  16.  
  17.     '「今日の天気」以降の文字列を抜き出します。
  18.     nukidashi = Mid(getSource, InStr(getSource, "今日の天気"))
  19.  
  20.     '抜き出した文字列の中で、最初の　「　<img　」以降を抜き出します。
  21.     nukidashi = Mid(nukidashi, InStr(nukidashi, "<img"))
  22.  
  23.     '抜き出した文字列の中で、最初の　「　"　」の次の文字以降を抜き出します。
  24.     nukidashi = Mid(nukidashi, InStr(nukidashi, """") + 1)
  25.  
  26.     '抜き出した文字列の中で、最初の　「　"　」の前の文字までを抜き出します。
  27.     nukidashi = Mid(nukidashi, 1, InStr(nukidashi, """") - 1)
  28.  
  29.     Debug.Print nukidashi
  30.  
  31. End Sub

画像のURLを取ってくるところまで書いちゃいましたが、

・まず、「今日の天気」以降を抜き出します。

・次に、その文字列から「<img 」を探し、それ以降の文字列を抜き出します。

・次に、その文字列から　「 " 」（src="の部分です）を探し、その文字の次の文字以降の文字列を抜き出します。

・最後に、その文字列から 「"」（src=の終わりの"です）を探し、その文字の前の文字までを抜き出します。

実行すると、こんな感じ。

取れました（＾＾）

後は、このURLの画像を貼り付ければいいんですが、、、画像のダウンロードってどうやるのか？

「excel vba ファイルをダウンロード」

で検索して見つかった、こちらのページからリンクされていた、こちらのページの説明がわかりやすかったです。

ということで、こんな感じ。

PLAIN TEXT
Visual Basic:
  1. 'URLDownloadToFile API from URLMON.
  2. Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
  3. "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal _
  4. szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
  5.  
  6.  
  7. Private Sub CommandButton1_Click()
  8.  
  9.     Dim oHttp As Object
  10.     Dim getSource As String
  11.     Dim nukidashi As String
  12.     Dim saikoukion As String
  13.  
  14.     Dim strURL As String
  15.     Dim strFNAME As String
  16.     Dim returnValue
  17.  
  18.     Set oHttp = CreateObject("MSXML2.XMLHTTP")
  19.     oHttp.Open "GET", "http://weather.livedoor.com/area/20/72.html", False
  20.     oHttp.Send
  21.     getSource = oHttp.responseText
  22.  
  23.     '最高気温を取ってきます。
  24.     nukidashi = Mid(getSource, 1, InStr(getSource, "℃"))
  25.     saikoukion = Mid(nukidashi, InStrRev(nukidashi, ">") + 1)
  26.  
  27.     'シートに代入します
  28.     ActiveSheet.Cells(1, 4).Value = saikoukion
  29.  
  30.     '「今日の天気」以降の文字列を抜き出します。
  31.     nukidashi = Mid(getSource, InStr(getSource, "今日の天気"))
  32.  
  33.     '抜き出した文字列の中で、最初の　「　<img　」以降を抜き出します。
  34.     nukidashi = Mid(nukidashi, InStr(nukidashi, "<img"))
  35.  
  36.     '抜き出した文字列の中で、最初の　「　"　」の次の文字以降を抜き出します。
  37.     nukidashi = Mid(nukidashi, InStr(nukidashi, """") + 1)
  38.  
  39.     '抜き出した文字列の中で、最初の　「　"　」の前の文字までを抜き出します。
  40.     strURL = Mid(nukidashi, 1, InStr(nukidashi, """") - 1)
  41.  
  42.     'ダウンロードする画像をルートのtenki.gifにします。
  43.     '画像上書きしますので、注意してください。
  44.     strFNAME = "\tenki.gif"
  45.  
  46.     'URLDownloadToFile API をコールする
  47.     returnValue = URLDownloadToFile(0, strURL, strFNAME, 0, 0)
  48.  
  49.     '画像を挿入したいセルを選択します。
  50.     ActiveSheet.Cells(1, 2).Select
  51.  
  52.     'ダウンロードした画像を今のセルの位置に挿入します。
  53.     ActiveSheet.Pictures.Insert Filename:="\tenki.gif"
  54.  
  55. End Sub

もう、全部作っちゃいました（＾＾；）。コメントが入ってますので、それを見ればどこで何をやってるかは分かると思います。

このファイルがあるドライブのルートディレクトリにtenki.gifという名前で画像を保存して、それをシートに貼り付ける、というふうになっています。なので、tenki.gifというファイルがあったら、上書きされちゃいますので実行するときは注意してください。

実行すると、こんな感じ

ん、できました（＾＾）

ここに置いておきます→vbastudy_26

RSS Feed   Trackback URL  Add comment   Edit Page

コメントをどうぞ