固定長形式テキストデータの書き出し

項目区切りはなく、固定バイト位置で項目を見分ける形式のテキストファイルです。
COBOL言語で作成されたシステムで取り扱うことが多い形式です。  私もWindows環境以前は、COBOL言語でのシステム開発を行なっていたのですが、COBOL言語でのデータファイルの取り扱いは「固定長形式」がほとんどです。
CSV形式テキスト(カンマ区切り、*.csv)などの概念がないので不便に見えますが、レコード上を項目定義してしまうので読み込んだ時点で項目ごとに個別の変数で扱える利便性があります。 ここではCOBOL言語の説明をするわけではありませんが、そのインタフェースとなるファイルをシート上のデータを元にして作成するというサンプルです。
サンプルは、「固定長形式テキストデータの読み込み」で読み込んでいるものと同じですから、セットで確認すると良いでしょう。
2021/06/27に不具合修正を行ないました。   一番最後の「指定バイト数の固定長データ作成(文字列処理:FP_GetFixLeng)」でセルの文字列の先頭か最後に空白があるとバイト数が誤って算出されるケースが見つかりこれを修正しています。
ソースの一部の転用利用もあると思いますので、対象箇所にはコメントを入れてありますのでご利用の方は修正をお願いいたします。



シート上の簡単な一覧データをサンプルにします。
固定長形式テキストデータの書き出しのサンプル
(画像をクリックすると、このサンプルがダウンロードできます)
サンプルなのでこのような簡単なデータを用いることにします。固定長形式テキストデータファイルの出力先は「自ブック」のフォルダの「SAMPLE.dat」です。



固定長形式ファイルの内容は以下のようにしています。
No. 項目名 タイプ 桁数 COBOL言語での編集
1 コード 文字 5  PIC X(05)
2 メーカー 文字 10  PIC X(10)
3 品名 文字 15  PIC X(15)
4 数量 符号無数値 4  PIC 9(04)
5 単価 符号無数値 6  PIC 9(06)
6 金額 符号無数値 8  PIC 9(08)
48  
「桁数」は実際には「バイト数」になります。項目順に左から境界文字なく指定バイト数単位で並べていって、レコード当たり48バイトでファイルに出力するわけです。

まず、出力された固定長形式テキストファイルを見てみます。
Windows標準の「メモ帳」でも見ることはできますが、空白や改行など細かい編集状態が確認しにくいので「秀丸」というテキストエディタで見ることにします。(若干、設定を変更しています。)
固定長形式テキストデータを参照する(改行付き)
(この画像をクリックすると、このページのサンプルがダウンロードができます。)
こちらは、改行(CrLf)コード付きで出力した状態です。改行(CrLf)コードが各レコード右端に付加されるので、実際は1レコードが50バイトになります。



固定長形式テキストデータを参照する(改行なし)
こちらは、改行(CrLf)コードなしで出力した状態です。上の表の通り1レコード48バイトとなり、49バイト目からすぐに2レコード目が出力されているのでレコード境界が分かりにくいですが、 COBOL言語のアプリケーションでは単にバイト数単位で読み込むので通常はこちらの方法で出力させることになると思います。
改行(CrLf)コード付きで出力する場合は、COBOL側のレコード定義で右端に2バイト分のFILLER項目を追加する必要があります。



固定長形式テキストデータを参照する(改行なし)
改行(CrLf)コードなしでも、テキストエディタ側で表示折り返しの桁数を48バイトに合わせると、このように表示されます。



固定長形式テキストデータを参照する(Excel)
一方、改行(CrLf)コード付きで出力した場合は、Excelのテキストウィザードを使ってこのように項目を分割させて取り込むこともできます。

それでは、コードを見てみましょう。

'***************************************************************************************************
'   固定長形式テキストファイル書き出しサンプル(FSO)                 Module1(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'   [参照設定]
'   ・Microsoft Scripting Runtime
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'03/07/25(1.00)新規作成
'03/12/04(1.01)初回修正
'20/02/26(1.10)*.xlsm化、他
'21/06/27(1.11)不具合修正(FP_GetFixLeng:桁数判定不一致)
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsTitle As String = "固定長形式テキストファイル書き出し"
Private Const g_cnsFilename As String = "SAMPLE1.dat"

'***************************************************************************************************
'   ■■■ ワークシート側からの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名 :WRITE_FixLngFile1
'* 機能  :固定長形式テキストファイル書き出しサンプル(FSO)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月25日
'* 作成者 :井上 治
'* 更新日 :2020年02月26日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:サンプルなのでエラー処理は行なっていません
'***************************************************************************************************
Sub WRITE_FixLngFile1()
    '-----------------------------------------------------------------------------------------------
    Dim objFso As FileSystemObject                              ' FileSystemObject
    Dim objTs As TextStream                                     ' TextStream
    Dim lngRow As Long                                          ' 収容するセルの行
    Dim lngRowMax As Long                                       ' データが収容された最終行
    Dim lngRec As Long                                          ' レコード件数カウンタ
    Dim strFileName As String                                   ' OPENするファイル名(フルパス)
    '-----------------------------------------------------------------
    Set objFso = New FileSystemObject
    ' フルパスファイル名の編集
    strFileName = objFso.BuildPath(ThisWorkbook.Path, g_cnsFilename)
    ' 収容最終行の判定(Excel認知の最終行から上に向かってデータがある行を探す)
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData      ' オートフィルタ解除
    lngRowMax = Range("$A$" & Rows.Count).End(xlUp).Row
    ' データ未登録は終了
    If lngRowMax < 2 Then
        MsgBox "テキストをA列2行目から入力してから起動して下さい。", vbExclamation, g_cnsTitle
        Set objFso = Nothing
        Exit Sub
    End If
    '-----------------------------------------------------------------
    ' 指定ファイルをOPEN(出力モード)
    Set objTs = objFso.CreateTextFile(Filename:=strFileName, Overwrite:=True)
    Set objFso = Nothing
    ' 2行目から開始
    lngRow = 2
    '-----------------------------------------------------------------
    ' 最終行まで繰り返す
    Do While lngRow <= lngRowMax
        ' レコード件数カウンタの加算
        lngRec = lngRec + 1
        Application.StatusBar = "出力中です....(" & lngRec & "レコード目)"
        ' レコードを出力(レコード編集処理より受け取る)
        objTs.WriteLine FP_EditFixLngRec(lngRow)                ' 改行(CrLf)付き
'        objTs.Write FP_EditFixLngRec(lngRow)                    ' 改行(CrLf)なし
        ' 行を加算
        lngRow = lngRow + 1
    Loop
    '-----------------------------------------------------------------
    ' 指定ファイルをCLOSE
    objTs.Close
    Set objTs = Nothing
    Application.StatusBar = False
    ' 終了の表示
    MsgBox "ファイル出力が完了しました。" & vbCr & _
        "レコード件数=" & lngRec & "件", vbInformation, g_cnsTitle
End Sub

'***************************************************************************************************
'   ■■■ サブ処理(Private) ■■■
'***************************************************************************************************
'* 処理名 :FP_EditFixLngRec
'* 機能  :固定長形式テキストの1レコードの編集
'---------------------------------------------------------------------------------------------------
'* 返り値 :1レコード分の文字列(String)
'* 引数  :Arg1 = シート上の行(Long)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月25日
'* 作成者 :井上 治
'* 更新日 :2020年02月26日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Function FP_EditFixLngRec(ByVal lngRow As Long) As String
    '-----------------------------------------------------------------------------------------------
    Dim strRec As String                                            ' レコードテキスト
    ' A列(コード)は5バイトの文字列
    strRec = FP_GetFixLeng(Cells(lngRow, 1).Value, 5)
    ' B列(メーカー)は10バイトの文字列
    strRec = strRec & FP_GetFixLeng(Cells(lngRow, 2).Value, 10)
    ' C列(品名)は15バイトの文字列
    strRec = strRec & FP_GetFixLeng(Cells(lngRow, 3).Value, 15)
    ' D列(数量)は4バイトの数値
    strRec = strRec & Format(Cells(lngRow, 4).Value, "0000")
    ' E列(単価)は6バイトの数値
    strRec = strRec & Format(Cells(lngRow, 5).Value, "000000")
    ' F列(単価)は8バイトの数値
    strRec = strRec & Format(Cells(lngRow, 6).Value, "00000000")
    ' 編集したレコード内容を戻り値にセット(計48バイト)
    FP_EditFixLngRec = strRec
End Function

'***************************************************************************************************
'* 処理名 :FP_GetFixLeng
'* 機能  :指定バイト数の固定長データ作成(文字列処理)
'---------------------------------------------------------------------------------------------------
'* 返り値 :1項目分の文字列(String)
'* 引数  :Arg1 = 入力テキスト(String)
'*      Arg2 = バイト数(Long)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月25日
'* 作成者 :井上 治
'* 更新日 :2021年06月27日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Function FP_GetFixLeng(ByVal strInText As String, _
                               ByVal lngFixBytes As Long) As String
    '-----------------------------------------------------------------------------------------------
    Dim lngKeta As Long                                             ' 項目桁数
    Dim lngByte As Long                                             ' バイト数
    Dim lngByte2 As Long                                            ' バイト数WORK
    Dim lngByte3 As Long                                            ' バイト数WORK
    Dim lngIx As Long                                               ' 文字位置INDEX
    Dim intChar As Integer                                          ' 文字コード
    Dim strInText2 As String                                        ' 入力文字列(Trim)
    Dim strOutText As String                                        ' 編集後文字列
    strInText2 = Trim(strInText)
    lngKeta = Len(strInText2)
    '**********↓↓↓2021/06/27UPD↓↓↓(不具合修正:桁数不一致)
    'strOutText = strInText        ' ←NG
    strOutText = strInText2        ' ←OK
    '**********↑↑↑2021/06/27UPD↑↑↑
    ' バイト数判定
    For lngIx = 1 To lngKeta
        ' 1文字ずつ半角/全角を判断
        intChar = Asc(Mid(strInText2, lngIx, 1))
        ' 全角と判断される場合はバイト数に1を加える
        If ((intChar < 0) Or (intChar > 255)) Then
            lngByte2 = 2        ' 全角
        Else
            lngByte2 = 1        ' 半角
        End If
        ' 桁あふれ判定(右切り捨て)
        lngByte3 = lngByte + lngByte2
        If lngByte3 >= lngFixBytes Then
            If lngByte3 > lngFixBytes Then
                strOutText = Left(strInText2, lngIx - 1)
            Else
                strOutText = Left(strInText2, lngIx)
                lngByte = lngByte3
            End If
            Exit For
        End If
        lngByte = lngByte3
    Next lngIx
    ' 桁不足判定(空白文字追加)
    If lngByte < lngFixBytes Then
        strOutText = strOutText & Space(lngFixBytes - lngByte)
    End If
    FP_GetFixLeng = strOutText
End Function

'----------------------------------------<< End of Source >>----------------------------------------
  • 最初のプロシージャである「WRITE_FixLngFile1」が全体処理で、起動時はこれを呼び出します。 この記述は、前ページのCSV形式テキストデータの書き出し」後半のサンプルとファイル名の指定が異なる以外はほぼ同じです。 メインのループ中の「WriteLineメソッド」のところが1レコードの固定長文字列編集の呼び出しとなっています。
  • 2番目の「FP_EditFixLngRec」はシート上の「行」を引数として、その行の各セルのデータから48バイトのレコードを編集して返す役割を行ないます。
  • 3番目の「FP_GetFixLeng」は、「入力文字」と「バイト数」を引数として、固定長文字列項目の編集を行ないます。 「入力文字」が長すぎれば右をカットし、短ければ右に半角空白文字を補います。
    全角文字が「バイト数」の境界にまたぐ状態になる場合には、その全角文字はセットせずに半角空白文字で桁合わせするように配慮してあります。 今回のサンプルの「北海道味噌ラーメン」の編集がこれに当たります。
    全角文字が「バイト数」より長くなく、かつ「バイト数」の境界にまたぐことがなければ、StrConv関数(vbFromUnicode)LenB,LeftB関数で済ませてしまう方法もありますが、 ロジックの勉強にはループ処理で1文字ずつ検査していく方法もあるということでやってみました。



もう一つ、処理結果の説明にあった「改行(CrLf)コード」の件です。
ダウンロードしたままの状態では「改行(CrLf)コード」付きとなっていますが、

        ' レコードを出力(REC編集処理より受け取る)
        objTs.WriteLine FP_EditFixLngRec(lngRow)                ' 改行(CrLf)付き
'        objTs.Write FP_EditFixLngRec(lngRow)                    ' 改行(CrLf)なし
この部分の「objTs.Write」のコメント行を解放し、「objTs.WriteLine」の行をコメントに変更すると「改行(CrLf)コード」なしで出力されるようになります。

「符号付き数値項目」でのご注意です。
今回は難しいサンプルにならないように数値項目は全て「符号なし」としましたが、COBOL言語での「符号付き数値項目」の編集はちょっとやっかいです。 COBOL言語では、例えば「PIC S9(03)」などと定義しますが、有効数字が3桁で符号付きの場合、データ上では符号を含めても3バイトなのです。
通常は右端桁の文字を変化させることで符号を表意しますが、この処理を行なう場合は末桁の数値の値を編集文字として以下の表のように置き換える必要があります。
プラス値 マイナス値
数値 EBCDIC
コード
文字 Ascii
コード
数値 EBCDIC
コード
文字 Ascii
コード
+9 C9 I 49 -1 D1 J 4A
+8 C8 H 48 -2 D2 K 4B
+7 C7 G 47 -3 D3 L 4C
+6 C6 F 46 -4 D4 M 4D
+5 C5 E 45 -5 D5 N 4E
+4 C4 D 44 -6 D6 O 4F
+3 C3 C 43 -7 D7 P 50
+2 C2 B 42 -8 D8 Q 51
+1 C1 A 41 -9 D9 R 53
+0 C0 { 7B -0 D0 } 7D
この表の見方は分かるでしょうか。COBOL言語は文字コードでEBCDICコードが基本となり、符号付き数値の扱いは通常(特に指定がない限り)右端の桁の文字コードをプラスならC0C9、マイナスならD0D9で扱うことで符号桁を取らないようにしているのです。 そこで、それに対応する文字とAsciiコードをまとめて表にしました。
変換例を挙げると、数値で「128」は「12H」と編集し、数値で「-120」は「12}」と編集することになります。 このような変換が難しい場合は、数値項目の隣に「+」「-」という文字を別項目として出力してしまって、COBOL言語側で判断してマイナス処理してもらうように考えても良いと思います。
さらにこの他、COBOL言語では、レコードの桁数を削減する目的で「パック型数値」などが用いられますが、そこまでは「無理」としておいた方が良いと思います。