Access2000には、テーブルのデータをXML形式で出力する そのものずばりの機能があります。
Dim rcd As New ADODB.Recordset
rcd.Open "テーブル", CurrentProject.Connection, adOpenStatic, adLockReadOnly
rcd.Save "c:\save.xml", adPersistXML
rcd.Close
ただしこの方法では、項目の定義やら何やらをこまごまと出力してくれる割には 肝心のデータ部分がいまいち使いづらい形をしています。 こんな感じで。
そこで、単純なXML形式で出力するようなサブルーチンを作ってみました。
Sub XmlOut(tblname As String, filepath As String, filename As String, roottag As String, xsl As Boolean) Dim fno As Long fno = FreeFile() Open filepath & filename & ".xml" For Output As #fno 'ヘッダー部 Print #fno, "<?xml version=""1.0"" encoding=""Shift_JIS""?>" Dim t As String If xsl Then t = " href=""" & filename & ".xsl""" Print #fno, "<?xml-stylesheet type=""text/xsl""" & t & "?>" Print #fno, "<" & roottag & "全体>" Dim rcd As New ADODB.Recordset rcd.Open tblname, CurrentProject.Connection, adOpenKeyset, adLockOptimistic 'テーブルの全項目名を取得 Dim fld As Field, fldct As Integer fldct = rcd.Fields.Count Dim fldname() As String ReDim fldname(fldct) Dim i As Integer For i = 1 To fldct fldname(i) = rcd.Fields(i - 1).Name Next '各レコードの処理 Do While Not rcd.EOF Print #fno, "<" & roottag & "詳細>" For i = 1 To fldct Dim val As Variant val = rcd(fldname(i)).Value If IsNull(val) Then val = "" Print #fno, "<" & fldname(i) & ">" & val & "</" & fldname(i) & ">"; Next Print #fno, "" Print #fno, "</" & roottag & "詳細>" rcd.MoveNext Loop rcd.Close 'フッター部 Print #fno, "</" & roottag & "全体>" Close #fno End Sub
使い方は次のようになります。 こんな感じで出力されます。
Call XmlOut("テーブル", "c:\", "org", "テスト", False)
第1引数 | テーブル名 |
第2引数 | 出力するファイルのパス |
第3引数 | 出力するファイル名(拡張子は除く) |
第4引数 | タグ名 |
第5引数 | ヘッダー部にXSLファイル名を出力するかどうか |
ちなみに、サンプルに使ったテーブルは以下のようなものです。