Excel VBA:Microsoft.XMLDOMを使ってRSSフィードの内容をセルに出力するVBAのサンプルプログラム

"Microsoft.XMLDOM"の勉強をしてた際に作成したVBAのサンプルプログラム。

指定したRSSフィード内容(タイトル、概要、詳細URL)をセルに出力する簡単なVBAサンプルプログラム。

応用として、Excelに記述した複数のRSSフィードを読み込んで別の表に出力するVBAのサンプルプログラムも作成してみた。

RSSフィードの名前とURLをExcelの表に記述しておくと、順番にそのRSSフィードを読み込んで、5件づつ「タイトル」、「概要」、「詳細ページのURL」を別の表に順番に書き出すというもの。

使い道があるのかよくわからないけど、せっかく書いたので覚書しておく。

以下Excel VBAのプログラムを記述。(ちなみにちょっと変えればAccessでも使える。)

RSSフィードをセルに書き出すサンプルプログラム

まずは基本的なサンプルプログラムを記載する。

VBAのプログラム中に直接RSSフィードのURLを指定して5件分の「タイトル」、「概要」、「詳細ページのURL」をアクティブセルから書き出していく。

ちなみにサンプルに使っているRSSフィードは、「CNET Japan」のRSS。

Sub RssSample01()
Dim xmlDoc As Object, RSSURL As String, rCode As Boolean
Dim titleNodes, decriptNodes, linkNodes, i As Integer, j As Integer
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
    xmlDoc.async = False
    'CNET JapanのRSSを取得
    RSSURL = "http://feeds.japan.cnet.com/cnet/rss"
    rCode = xmlDoc.Load(RSSURL)
        If rCode = False Then
            MsgBox "読み込めませんでした。", vbCritical
            Exit Sub
        End If
    
    Set titleNodes = xmlDoc.selectNodes("//item/title")
    Set decriptNodes = xmlDoc.selectNodes("//item/description")
    Set linkNodes = xmlDoc.selectNodes("//item/link")
    
    '5件分のフィードを出力
    j = 0
    For i = 1 To 5
        With ActiveCell
            .Offset(j, 0).Value = titleNodes(i).Text
            .Offset(j, 1).Value = decriptNodes(i).Text
            .Offset(j, 2).Value = linkNodes(i).Text
        End With
        j = j + 1
    Next i
End Sub

RSSフィードをセルに書き出すサンプルプログラム応用版

次のサンプルは、上記のサンプルを応用したもの。

ちょっと"Offset"だらけで見づらいかも。

まず、取得したいRSSフィードの一覧を記述した表を用意。

次に1列空けたとなりに取得したRSSフィードの「タイトル」、「概要」、「詳細ページのURL」を記述する表を用意。

どのRSSフィードの情報かわからなくなるので、RSSフィード名を書きだすセルも用意した。

以下で紹介するVBAのサンプルプログラムは、この表のアドレスをそのまま参照しているので、動作させる時はこの表通りに書くこと。

表サンプル

上記の表を使ったVBAのサンプルプログラムはこんな感じ。

Sub RssSample02()
Dim xmlDoc As Object, RSSURL As String, rCode As Boolean
Dim titleNodes, decriptNodes, linkNodes, i As Integer, j As Integer
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
    xmlDoc.async = False
    
    Worksheets("sheet1").Range("a2").Select
        j = 0
        Do Until ActiveCell.Value = ""
            RSSURL = ActiveCell.Offset(0, 1).Value
            rCode = xmlDoc.Load(RSSURL)
                If rCode = False Then
                    MsgBox "読み込めませんでした。", vbCritical
                    Exit Sub
                End If
            
            Set titleNodes = xmlDoc.selectNodes("//item/title")
            Set decriptNodes = xmlDoc.selectNodes("//item/description")
            Set linkNodes = xmlDoc.selectNodes("//item/link")
    
            '5件分のフィードを出力
            For i = 1 To 5
                With ActiveCell
                    .Offset(j, 3).Value = ActiveCell.Value
                    .Offset(j, 4).Value = titleNodes(i).Text
                    .Offset(j, 5).Value = decriptNodes(i).Text
                    .Offset(j, 6).Value = linkNodes(i).Text
                End With
                j = j + 1
            Next i
            ActiveCell.Offset(1, 0).Select
            j = j - 1
        Loop
    Worksheets("sheet1").Range("d1").Select
        Selection.CurrentRegion.Select
        Selection.Borders.LineStyle = True
        
End Sub

わかりづらいかもしれないけど、実行結果。

Accessだったら取得した情報をデータベース化できるから、Accessのほうがいいかもね。

ふと思ったけど、よくいかがわしい?情報商材なんかでRSSからブログ記事を自動作成なんてのがあるけど、そんなのもこういうプログラムを応用してんのかなーと思った。

悪用しないように！