Excel VBAでWebサービス - Excelでフィードを読もう（RSS2.0編）

HTTP通信、RSS解析を行うVBAを記述する

外部ユーザ関数getFeedを定義します。

［リスト3］HTTP通信、RSS解析を行う

Private Function getFeed(url As String, genre As String) As String

    '(1)URLの入力チェック
    If Len(url) = 0 Then
        getFeed = "URL未入力"
        Exit Function
     End If

    '(2)HTTP通信によるリクエスト送信
    Dim xmlhttp As MSXML2.xmlhttp 'HTTP通信用オブジェクトを格納
    Set xmlhttp = New MSXML2.xmlhttp 'HTTP通信用オブジェクトの生成
    Dim status As String 'HTTPリクエストの成否を格納
    Dim resText As String 'HTTPレスポンスを格納（テキスト）

    xmlhttp.Open "GET", url, False 'GETメソッド、非同期通信で接続
    xmlhttp.send 'HTTPリクエストを実送信
    status = xmlhttp.statusText 'リクエスト成否の状態を取得

    If status <> "OK" Then
        Set xmlhttp = Nothing 'HTTP通信用オブジェクトを解放
        getFeed = "リクエスト失敗"
        Exit Function
    End If
    resText = xmlhttp.responseText 'レスポンスを格納
    Set xmlhttp = Nothing 'HTTP通信用オブジェクトを解放

    '(3)XMLデータの解析
    Dim xmldata As MSXML2.DOMDocument
    Dim rss As MSXML2.IXMLDOMElement
    Dim itemList As MSXML2.IXMLDOMNodeList
    Dim item As MSXML2.IXMLDOMNode

    Set xmldata = New MSXML2.DOMDocument
    xmldata.LoadXML resText 'レスポンスをXML文書として格納

    '(4)XML文書のrss要素にアクセス
    Set rss = xmldata.DocumentElement
    If rss.tagName <> "rss" Or rss.getAttribute("version") <> "2.0" Then
        getFeed = "非RSS2.0形式"
        Exit Function
    End If

    '(5)記事を「item」要素のリストとして取得し、一旦配列変数に格納
    Set itemList = rss.getElementsByTagName("item")
   '(6)itemListの件数だけ、記事リストのサイズを広げる（既存データは保持）
    ReDim Preserve artList(nofList + itemList.Length - 1)
    Dim value As String
    For i = 0 To itemList.Length - 1
        Set item = itemList(i)
        For j = 0 To item.ChildNodes.Length - 1
            value = item.ChildNodes(j).Text
            Select Case item.ChildNodes(j).nodeName
            Case "title"
                artList(nofList + i).title = value
            Case "link"
                artList(nofList + i).link = value
            Case "description"
                artList(nofList + i).description = cdataConv(value)
            Case "pubDate"
                If value <> "" Then
                    artList(nofList + i).pubDate = timeConv(value)
                End If
            End Select
        Next j
        artList(nofList + i).genre = genre
    Next i
    nofList = nofList + itemList.Length
    Set xmldata = Nothing 'XMLオブジェクトを解放
    getFeed = "OK"

End Function

(1)受け取った引数urlが空文字の場合は、「URL未入力」を返して終了します。
(2)HTTP通信用オブジェクトを生成し、セルに入力されたURLに対して、リクエストを送信します。成功したら、レスポンスをstatusに格納して、オブジェクトは解放します。
(3)オブジェクト変数xmldataにデータを読み込みます。
(4)ルート要素のタグ名が「rss」でない場合、またはversion属性が「2.0」でない場合は、「非RSS2.0形式」を返して終了します。
(5)記事を取り出す処理です。rss配下のitem要素をgetElementsByTagNameメソッドにより取り出し、itemListオブジェクトに格納します。

図6．XMLデータの構造

これを一旦、構造型配列artListに格納するため、ReDim Preserve命令により件数をitemListに合わせて拡張（既存データは保持）します。

itemListからインデックスを使って、item要素ごとにその子要素の配列を取得します。この中に<title>などがあるはずですが、要素の有無、順序はサイトによって異なります。このため子要素すべてを走査し、名称が一致すれば、要素ごとに必要な処理を行った上で、artListに格納します。

description要素には、HTMLタグが含まれる可能性があるため、ユーザ定義関数cdataConvにより、<～>の形の文字列を空文字に置換します。またpubDate要素は、RFC822形式（Tue, 01 Nov 2011 10:43:01 +0900）になっているため、ユーザ定義関数timeConvを使って、「年/月/日時:分:秒」の形に組み立てます。いずれのユーザ定義関数も、JScriptの力を借りています（コードの説明は省略）。

nofListは、フィードの記事数itemList.lengthだけ加算し、xmldataオブジェクトを解放し、「OK」を返して終了します。

以上で完成です。「更新する」ボタンをクリックして、更新データが表示されれば成功です（完全なコードは、ここからダウンロードしてください）。

まとめ

Excelによるニュースの読み込みはいかがでしたか。RSS2.0形式であれば、URLを変更することにより、様々なニュース配信サイトの情報を収集できます。

WINGSプロジェクト遠藤存著/山田祥寛監修
WINGS プロジェクトについて
テクニカル執筆プロジェクト(代表山田祥寛)。海外記事の翻訳から、主にWeb開発分野の書籍・雑誌/Web記事の執筆、講演等を幅広く手がける。2011年5月時点での登録メンバは35名で、現在も一緒に執筆をできる有志を募集中。