XML(RSS)を読み込んで、Excelに書き出す
メモ。
YahooのRSSをxmlReaderで読み込んで、Excelに書き出します。
XMLデータの例
<?xml version="1.0" encoding="UTF-8" ?> - <rss xmlns:blogChannel="http://backend.userland.com/blogChannelModule" version="2.0"> - <channel> <title>Yahoo!ニュース・トピックス - トップ</title> <link>http://news.yahoo.co.jp/</link> <description>Yahoo! JAPANのニュース・トピックスで取り上げている最新の見出しを提供しています。</description> <language>ja</language> <pubDate>Thu, 07 May 2015 12:47:52 +0900</pubDate> - <item> <title>箱根で火山性地震続く 警戒を</title> <link>http://dailynews.yahoo.co.jp/fc/local/kanagawa/?id=6159142</link> <pubDate>Thu, 07 May 2015 12:30:28 +0900</pubDate> <enclosure length="133" url="http://i.yimg.jp/images/icon/photo.gif" type="image/gif" /> <guid isPermaLink="false">yahoo/news/topics/6159142</guid> </item> - <item> <title>慰安婦世界遺産に 韓国で動き</title> <link>http://dailynews.yahoo.co.jp/fc/domestic/ianfu/?id=6159140</link> <pubDate>Thu, 07 May 2015 11:59:45 +0900</pubDate> <guid isPermaLink="false">yahoo/news/topics/6159140</guid> </item> - <item> <title>女児誘拐未遂 元巡査が認める</title> <link>http://dailynews.yahoo.co.jp/fc/domestic/abduction/?id=6159141</link> <pubDate>Thu, 07 May 2015 12:30:28 +0900</pubDate> <guid isPermaLink="false">yahoo/news/topics/6159141</guid> </item> - <item> <title>結婚コスパ悪い 東京の価値観</title> <link>http://dailynews.yahoo.co.jp/fc/domestic/konkatsu/?id=6159127</link> <pubDate>Thu, 07 May 2015 10:00:01 +0900</pubDate> <enclosure length="133" url="http://i.yimg.jp/images/icon/photo.gif" type="image/gif" /> <guid isPermaLink="false">yahoo/news/topics/6159127</guid> </item> - <item> <title>サル命名に批判 動物園は困惑</title> <link>http://dailynews.yahoo.co.jp/fc/local/zoo_and_aquarium/?id=6159143</link> <pubDate>Thu, 07 May 2015 12:30:28 +0900</pubDate> <enclosure length="133" url="http://i.yimg.jp/images/icon/photo.gif" type="image/gif" /> <guid isPermaLink="false">yahoo/news/topics/6159143</guid> </item> - <item> <title>真夜中の一戦 錦織が初戦突破</title> <link>http://dailynews.yahoo.co.jp/fc/sports/nishikori_kei/?id=6159120</link> <pubDate>Thu, 07 May 2015 12:32:32 +0900</pubDate> <enclosure length="133" url="http://i.yimg.jp/images/icon/photo.gif" type="image/gif" /> <guid isPermaLink="false">yahoo/news/topics/6159120</guid> </item> - <item> <title>GTO作者の妻 藤沢あやの出産</title> <link>http://dailynews.yahoo.co.jp/fc/entertainment/baby/?id=6159138</link> <pubDate>Thu, 07 May 2015 11:43:41 +0900</pubDate> <guid isPermaLink="false">yahoo/news/topics/6159138</guid> </item> - <item> <title>武井咲 交際報道にコメント</title> <link>http://dailynews.yahoo.co.jp/fc/entertainment/takei_emi/?id=6159135</link> <pubDate>Thu, 07 May 2015 11:12:28 +0900</pubDate> <enclosure length="133" url="http://i.yimg.jp/images/icon/photo.gif" type="image/gif" /> <guid isPermaLink="false">yahoo/news/topics/6159135</guid> </item> </channel> </rss>
Imports Microsoft.Office.Interop Imports System.Xml Public Class Form1 Const YahooRSS As String = "http://rss.dailynews.yahoo.co.jp/fc/rss.xml" Dim xlApp As Excel.Application = Nothing Dim xlBookNew As Excel.Workbook = Nothing Dim xlSheetNew As Excel.Worksheet = Nothing Dim strNewPath As String Dim strNow As String Dim intY As Integer Dim blnErrFlag As Boolean = False Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Try Create_Excel() 'Excelの生成 Read_RSS() 'XMLパース&Excelへの書き込み処理 Catch ex As Exception MessageBox.Show("予期せぬエラーが発生しました・・・", "Error!", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) blnErrFlag = True Finally '▼解放処理 ' 既存ファイル MRComObject(xlSheetNew) MRComObject(xlBookNew) xlApp.Quit() MRComObject(xlApp) xlSheetNew = Nothing xlBookNew = Nothing xlApp = Nothing If blnErrFlag = False Then Timer(0.5) 'サブプロシージャ呼び出し MessageBox.Show("完了しました。", "完了通知", MessageBoxButtons.OK, MessageBoxIcon.Information) End If Application.Exit() End End Try End Sub Private Sub Read_RSS() '項目のセット With xlSheetNew .Cells(1, 1).Value = "title" .Cells(1, 2).Value = "link" .Cells(1, 3).Value = "pubDate" .Cells(1, 4).Value = "enclosure" .Cells(1, 5).Value = "guid" .Cells(1, 6).Value = "isPermaLink" End With intY = 1 Try xlApp.ScreenUpdating = False Using xmlReader As XmlReader = xmlReader.Create(YahooRSS) xmlReader.ReadToFollowing("item") While xmlReader.Read If xmlReader.NodeType = XmlNodeType.Element Then Select Case xmlReader.LocalName Case "title" intY += 1 'titleの時はカウンターを加算 xlSheetNew.Cells(intY, 1).Value = xmlReader.ReadString() Case "link" xlSheetNew.Cells(intY, 2).Value = xmlReader.ReadString() Case "pubDate" xlSheetNew.Cells(intY, 3).Value = xmlReader.ReadString() Case "enclosure" If xmlReader.HasAttributes Then xlSheetNew.Cells(intY, 4).Value = xmlReader.GetAttribute("url") End If Case "guid" xlSheetNew.Cells(intY, 5).Value = xmlReader.ReadString() If xmlReader.HasAttributes Then xlSheetNew.Cells(intY, 6).Value = xmlReader.GetAttribute("isPermaLink") End If End Select End If End While End Using xlApp.ScreenUpdating = True Create_Dir() 'サブプロシージャ呼び出し xlBookNew.SaveAs(strNewPath & "\" & strNow & "_RSS Reader.xlsx") xlBookNew.Close(False) Catch ex As Exception MessageBox.Show("XML読み込み時にエラーが発生しました・・・", "Error!", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) End Try End Sub Private Sub Create_Excel() 'Excel が既に起動されているかどうかを調べます-------------- Try '第1引数を指定せずに GetObject 関数を呼び出すと、 'アプリケーションのインスタンスへの参照が返されます 'Excel が起動されていないと、エラーが発生 '起動していればそのExcelを使用します xlApp = GetObject(, "Excel.Application") Catch ex As Exception 'Excel が起動していないなら新規にインスタンスを生成します xlApp = CreateObject("Excel.Application") End Try '---------------------------------------------------------- xlApp.Visible = True 'エクセルを表示(表示しなくてもOK) xlBookNew = xlApp.Workbooks.Add() '新規ブック作成 xlSheetNew = xlBookNew.Worksheets(1) 'シートオブジェクト化 End Sub Private Sub Create_Dir() 'フォルダ作成 strNow = Now() strNow = Replace(strNow, "/", ".") '禁止符号を変換 strNow = Replace(strNow, ":", ".") '禁止符号を変換 '------------------------------------------------------------- '20XX.MM.DD hh:mm:SS だと19文字 '午前中は 20XX.MM.DD h:mm:SS と時間が1桁表示で18文字になる If Len(strNow) <> 19 Then '午前時間のゼロ追加 strNow = Microsoft.VisualBasic.Left(strNow, 11) & "0" & Microsoft.VisualBasic.Right(strNow, 7) End If '------------------------------------------------------------- 'サブフォルダ作成 IO.Directory.CreateDirectory(Application.StartupPath & "\" & strNow) 'サブフォルダのパスを変数に格納 strNewPath = Application.StartupPath & "\" & strNow End Sub Private Sub MRComObject(ByVal objCom As Object) '■Comの解放処理 Try System.Runtime.InteropServices.Marshal.ReleaseComObject(objCom) Catch ex As Exception objCom = Nothing Finally objCom = Nothing End Try End Sub Private Sub Timer(ByVal Cc As Double) Dim dblTimer As Double = Microsoft.VisualBasic.Timer Do While Microsoft.VisualBasic.Timer - dblTimer < Cc Application.DoEvents() Loop End Sub End Class