十日日記

Link AS/400のファイル記述をADOで得る

ExcelからAS/400にデータ接続してファイル（テーブル）のデータを得るとき、列見出しがフィールド名になるのが以前から不満だった。AS/400ではフィールド名の長さを英数大文字6文字に押さえる慣習があり、見慣れないフィールドは正体がわからなくなる。AS/400にはフィールド名のほかに「フィールドテキスト記述」という項目もあって、こちらは日本語が使用可能になっている。列見出しをフィールド名ではなくテキスト記述で得たいと思うのは自然な心情だ。

ADOやDAOを使ってファイル記述が得る方法を探るため、『The i5/OS And Microsoft Office Integration Handbook』という書籍も買ってみた。だが残念ながら、p.95を読むかぎりでは手で直すような雰囲気だった。フィールドの数が100近くあるときに、そんな面倒なことはできない。（なお、同書を通じてIBMDA400・IBMDASQL・IBMDARLAという3つのADOプロバイダーの使い分けを知ったので、役に立たなかったわけではない。）

決め手になったのは、iSeries Access for Windowsに付属するProgrammer's Tool Kitに含まれていたヘルプ（OLE DB テクニカル・リファレンス）の記載だった。

iSeries ファイルの特定フィールドの詳細については、ファイル・フィールド記述の表示(DSPFFD)CLコマンドを使用してください。

いったんCLでファイルに出力して、それを得るという2段構えでないとファイル記述は取得できないようだ。せっかくなのでVBScriptのコード片を以下に記しておく。一読してわかるようにMain()のみにしてエラー処理も省いたので、そのままでは使い物にならないと思う。

' 2010-01-19 na@10days.org
' AS/400からADOでファイル定義を得て
' デスクトップにout.txtとしてTSVファイルを
' 出力するサンプルVBScriptソース

Option Explicit

Const TGTLIBFILE  = "LIBRARY/FILENAME"' ライブラリ/ファイル名を記載
Const TMPLIBFILE  = "TMPLIB/FILENAME" ' 中間ファイル。QTEMP不可
Const ASIPADDR    = "192.168.x.x"     ' AS/400のIPアドレス
Const ASUSR       = "USERNAME"        ' AS/400のユーザー名
Const ASPWD       = "PASSWORD"        ' AS/400のパスワード
Const PFONLY      = True              ' 物理ファイルのみ出力
Const TXTFILENAME = "out.txt"         ' 出力テキストファイル名

' 出力するフィールド情報の指定
Dim dFlds
Set dFlds = CreateObject("Scripting.Dictionary")
dFlds.Add "WHFILE" , "ファイル"
dFlds.Add "WHLIB"  , "ライブラリ"
dFlds.Add "WHFTYP" , "タイプ" ' P=物理, L=論理, D=装置
dFlds.Add "WHFLDI" , "内部フィールド名"
dFlds.Add "WHFLDT" , "フィールドタイプ"
dFlds.Add "WHFLDB" , "フィールド長"
dFlds.Add "WHFLDD" , "桁数"
dFlds.Add "WHFLDP" , "小数桁数"
dFlds.Add "WHFTXT" , "記述"

' ADO定数
Const adCmdText = &H0001
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adClipString = 2
' FSO定数
Const ForWriting = 2

' AS/400に接続
Dim cn: Set cn = CreateObject("ADODB.Connection")
Dim scn
scn = "Provider=IBMDA400;"
scn = scn & "Data source=" & ASIPADDR & ";"
scn = scn & "User ID=" & ASUSR & ";"
scn = scn & "Password=" & ASPWD & ";"
cn.Open scn

' CLコマンドを実行して中間ファイルを出力
Dim sCLOutFile
sCLOutFile = "{{DSPFFD FILE(__TGTLIBFILE__) OUTPUT(*OUTFILE) OUTFILE(__TMPLIBFILE__)}}"
sCLOutFile = Replace(sCLOutFile, "__TGTLIBFILE__", TGTLIBFILE)
sCLOutFile = Replace(sCLOutFile, "__TMPLIBFILE__", TMPLIBFILE)
cn.Execute sCLOutFile, adCmdText

' 中間ファイルを取得
Dim rs: Set rs = CreateObject("ADODB.Recordset")
Dim sSQL
sSQL = "SELECT " & Join(dFlds.Keys, ",") & " FROM " & Replace(TMPLIBFILE, "/", ".")
If PFONLY Then
	sSQL = sSQL & " WHERE WHFTYP = 'P'"
End If
rs.Open sSQL, cn, adOpenStatic, adLockOptimistic

' TSVファイルのデータを作成
Dim vData
vData = Join(dFlds.Items, vbTab) & VbCrlf
vData = vData & rs.GetString(adClipString, ,vbTab , vbCrlf)

' デスクトップに出力
Dim shell: Set shell = CreateObject("WScript.Shell")
Dim sFilePath
sFilePath = shell.SpecialFolders("Desktop") & "\" & TXTFILENAME
Dim fs: Set fs = CreateObject("Scripting.FileSystemObject")
Dim fw: Set fw = fs.OpenTextFile(sFilePath, ForWriting, True)
fw.Write vData
fw.Close: Set fw = Nothing
Set fs = Nothing

' 接続解除
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing