WEBデータの取得方法｜ExcelマクロVBAサンプル集

最終更新日：2013-06-25

WEBデータの取得方法

WEBページのデータを取得して、エクセルのデータとして取り込みたいとの要望が多いようです。

いろいろ方法はあります。

QueryTables
InternetExplorer
MSHTML
MSXML2
順番に、以下で説明します。

まず、サンプルページとして、ヤフーファイナンスの、以下のページを使います。

Excelサンプル画像

http://info.finance.yahoo.co.jp/ranking/?kd=1&mk=1&tm=d&vl=a

このページの一覧表の部分をエクセルに取り込みます。

このページは、ランキングですので、複数ページあります。

上のURLは、最初のページです。

では２ページ目はと言うと、

http://info.finance.yahoo.co.jp/ranking/?kd=1&tm=d&vl=a&mk=1&p=2

このようなURLになります。

この場合、最期のp=2がページ数になっています。

これを変更すれば、各ページが取得できます。

p=1なら、最初のページも取得可能です。

従って、以降のマクロでは

http://info.finance.yahoo.co.jp/ranking/?kd=1&tm=d&vl=a&mk=1&p=1

として取得しています。

この数値を順次変更して取得すれば、複数ページの取得も可能です。

まずは、
エクセル本来の機能で、Webクエリです。

Sub sample1()
　　With ActiveSheet.QueryTables.Add(Connection:= _
　　　　"URL;http://info.finance.yahoo.co.jp/ranking/?kd=1&tm=d&vl=a&mk=1&p=1", _
　　　　Destination:=Range("$A$1"))
　　　　.Name = "?kd=1&tm=d&vl=a&mk=1&p=1"
　　　　.FieldNames = True
　　　　.RowNumbers = False
　　　　.FillAdjacentFormulas = False
　　　　.PreserveFormatting = True
　　　　.RefreshOnFileOpen = False
　　　　.BackgroundQuery = True
　　　　.RefreshStyle = xlInsertDeleteCells
　　　　.SavePassword = False
　　　　.SaveData = True
　　　　.AdjustColumnWidth = True
　　　　.RefreshPeriod = 0
　　　　.WebSelectionType = xlAllTables
　　　　.WebFormatting = xlWebFormattingNone
　　　　.WebPreFormattedTextToColumns = True
　　　　.WebConsecutiveDelimitersAsOne = True
　　　　.WebSingleBlockTextImport = False
　　　　.WebDisableDateRecognition = False
　　　　.WebDisableRedirections = False
　　　　.Refresh BackgroundQuery:=False
　　End With
End Sub

太字のxlAllTablesの指定で、tableのみ取得しています。

これで済む場合は、これが最も簡単です。

マクロの記録を使えば、そのまま使えます。

上記も、マクロの記録のままです。

次は、
InternetExplorerを、VBAから操作します。

Sub sample2()
　　Dim i As Long
　　Dim j As Long
　　
　　Dim objITEM As Object
　　Dim objIE As New InternetExplorer
　　objIE.Visible = False
　　
　　objIE.Navigate "http://info.finance.yahoo.co.jp/ranking/?kd=1&tm=d&vl=a&mk=1&p=1"
　　Call untilReady(objIE)
　　
　　Range("A1").CurrentRegion.Offset(1, 0).ClearContents
　　i = 2
　　j = 1
　　For Each objITEM In objIE.Document.getElementsByTagName("td")
　　　　Cells(i, j) = objITEM.innerText
　　　　j = j + 1
　　　　If j > 10 Then
　　　　　　j = 1
　　　　　　i = i + 1
　　　　End If
　　Next
　　objIE.Quit
　　Set objITEM = Nothing
　　Set objIE = Nothing
End Sub

Sub untilReady(objIE As Object, Optional ByVal WaitTime As Integer = 10)
　　Dim starttime As Date
　　starttime = Now()
　　Do While objIE.Busy = True Or objIE.ReadyState <> READYSTATE_COMPLETE
　　　　DoEvents
　　　　If Now() > DateAdd("S", WaitTime, starttime) Then
　　　　　　Exit Do
　　　　End If
　　Loop
　　DoEvents
End Sub

※「Microsoft Internet Control」を参照設定して下さい。

問題は、HTMLを取得後の解析になります。

For Each objITEM In objIE.Document.getElementsByTagName("td")

Tableのtrの中のtdで、必要なデータのみ取得しています。

これについては、VBAの知識ではなく、HTMLの知識が必要になります。

Table、tr、td等が分からない場合は、HTMLの勉強をして頂く必要があります。

ここでは、HTMLの解説は省略します。

※注意
untilReady内のループでは、本来なら、Sleepさせた方が良いのですが、
APIの使用になるので、ここでは省略しています。
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
を先頭に記述し、
ループ内で、適宜、
Sleep 100
程度を入れておくと良いでしょう。

さらに、
MSHTML.HTMLDocumentを使った方法です。

Sub sample3()
　　Dim i As Long
　　Dim j As Long
　　Dim objXML As New MSHTML.HTMLDocument
　　Dim htmlDoc As New MSHTML.HTMLDocument
　　Dim objITEM As Object

　　Set htmlDoc = objXML.createDocumentFromUrl("http://info.finance.yahoo.co.jp/ranking/?kd=1&tm=d&vl=a&mk=1&p=1", vbNullString)
　　Call untilReady(htmlDoc)

　　Range("A1").CurrentRegion.Offset(1, 0).ClearContents
　　i = 2
　　j = 1
　　For Each objITEM In htmlDoc.getElementsByTagName("td")
　　　　Cells(i, j) = objITEM.innerText
　　　　j = j + 1
　　　　If j > 10 Then
　　　　　　j = 1
　　　　　　i = i + 1
　　　　End If
　　Next

　　Set objITEM = Nothing
　　Set htmlDoc = Nothing
　　Set objXML = Nothing
End Sub
Sub untilReady(htmlDoc As MSHTML.HTMLDocument, Optional ByVal WaitTime As Integer = 10)
　　Dim starttime As Date
　　starttime = Now()
　　Do Until htmlDoc.ReadyState = "complete"
　　　　DoEvents
　　　　If Now() > DateAdd("S", WaitTime, starttime) Then
　　　　　　Exit Do
　　　　End If
　　Loop
　　DoEvents
End Sub

※「Microsoft HTML Object Library」を参照設定して下さい。

InternetExplorerの部分がMSHTML.HTMLDocumentになった程度で、

後は、ほとんど同じです。

さらに、
MSXML2.XMLHTTPを使った場合です。

Sub sample4()
　　Dim i As Long
　　Dim j As Long
　　Dim objXML As New MSXML2.XMLHTTP
　　Dim htmlDoc As Object
　　Set htmlDoc = New MSHTML.HTMLDocument
　　Dim objITEM As Object

　　With objXML
　　　　.Open "GET", "http://info.finance.yahoo.co.jp/ranking/?kd=1&tm=d&vl=a&mk=1&p=1", False
　　　　.send (Null)
　　　　htmlDoc.write .responseText
　　End With
　　
　　Range("A1").CurrentRegion.Offset(1, 0).ClearContents
　　i = 2
　　j = 1
　　For Each objITEM In htmlDoc.getElementsByTagName("td")
　　　　Cells(i, j) = objITEM.innerText
　　　　j = j + 1
　　　　If j > 10 Then
　　　　　　j = 1
　　　　　　i = i + 1
　　　　End If
　　Next

　　Set objITEM = Nothing
　　Set htmlDoc = Nothing
　　Set objXML = Nothing
End Sub

※「Microsoft XML, v3.0」（v3.0以上を指定して下さい）を参照設定して下さい。

サンプルとして書いてみましたが、HTMLの解析ができないので、

結局、MSHTML.HTMLDocumentを使う事になってしまいました。

また、
Dim htmlDoc As New MSHTML.HTMLDocument
としたのでは、

htmlDoc.writeでエラーになってしまいますので、ちょっと面倒です。

結果的には、MSHTML.HTMLDocumentの方で良いのではないかという気がします。

いずれにしても、

最初のWebクエリ以外では、HTMLの知識が必要になります。

ここが書けない場合は、Webクエリでシートに貼り付けた後で、

シート内のデータを解析して、必要なデータだけに編集する等が良いでしょう。