0

エクセルでRSSリーダー

通常VBAでweb上のデータを取得したい場合、IEオブジェクトをつくり正規表現で取り出すか、webクエリの更新で表示させるというのがメインだが、XMLデータを取得する方法。つまらない会議の最中の暇つぶしに有用。一応体裁はエクセルピアノだから。VBAコード的にはdescriptionノードが存在しない変則的なサイト(yahooNewsがそうであった、きちんと記事詳細はRSSに含めてほしい。最近始めた天気のRSSフィードには最高気温、最低気温含めてきちんとdescriptionがある)用に、On Error GoTo ErrHandler処理で適当にごまかしてある。ただあくまで「適当にごまかした」だけなので、descriptionがあるRSSフィードとないRSSフィードを混在させた場合、きちんとRSSフィードがある記事のダブり表示のバグがある可能性。かといって、descriptionをきちんと書かないRSSのために、タイトル・リンク情報だけの表示にとどめる、というのも馬鹿らしい。

Sub rss()
‘画面更新しない
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim xdoc As New DOMDocument
Dim xtree As IXMLDOMElement
Dim namelist As IXMLDOMNodeList
Dim node As IXMLDOMNode

Dim i As Integer
Dim j As Integer
‘rssURLを何個登録したか?
CT2 = Range(“h1”).Value
‘いったんクリア
Columns(“A:B”).Select
Selection.ClearContents
Columns(“D:D”).Select
Selection.ClearContents

For j = 1 To CT2

‘/*========================*/
‘/* データを取ってくる */
‘/*========================*/
xdoc.async = False
URL = Cells(j + 1, 6).Value
CT = Range(“g1”).Value
‘xdoc.Load (“http://labs.goo.ne.jp/blogscope/rss/index.rdf”)
xdoc.Load (URL)

‘/*========================*/
‘/* タイトルの取得 */
‘/*========================*/
‘ 全体をとってくる
Set xtree = xdoc.documentElement
‘ タイトルを集める
Set namelist = xtree.getElementsByTagName(“title”)
Set namelist2 = xtree.getElementsByTagName(“link”)
Set namelist3 = xtree.getElementsByTagName(“description”)

‘/*=========================*/
‘/* タイトル書き出し */
‘/*=========================*/

i = 0
Do While (Not namelist(i) Is Nothing)
ActiveSheet.Cells(CT + i + 2, 1) = namelist(i).nodeTypedValue
ActiveSheet.Cells(CT + i + 2, 2) = namelist2(i).nodeTypedValue
ActiveSheet.Cells(CT + i + 2, 4) = namelist3(i).nodeTypedValue
i = i + 1
Loop

Next

Range(“c1”).Select
End Sub

*初期設定 VBE(Alt+F11)の参照設定
microsoft XMLにチェックをつける


Leave a reply

You may use these HTML tags and attributes: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>