VBA セルから固定長ファイル、TSVファイル出力例

書き込み途中・・・・

VBAソース

Option Explicit
'===================================================================================================
Private Const g_cnsTitle As String = "固定長形式テキストファイル書き出し"
Private Const g_cnsFilename As String = "testData"


Sub ファイルを作成する()
    '-----------------------------------------------------------------------------------------------
    Dim objFso As FileSystemObject  ' FileSystemObject  ツールー参照設定ーMicrosoft Scripting Runtime
    Dim 固定長ts As TextStream      ' TextStream（固定長）
    Dim TSVts 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)
    
    
    '-----------------------------------------------------------------
    ' 指定ファイルをOPEN(出力モード)
    Set 固定長ts = objFso.CreateTextFile(Filename:=strFileName & ".txt", Overwrite:=True)
    Set TSVts = objFso.CreateTextFile(Filename:=strFileName & ".tsv", Overwrite:=True)
    Set objFso = Nothing
    
    '固定長トータルヘッダを出力
    固定長ts.Write 固定トータルヘッダ
    
    '固定長黒伝ヘッダを出力
    固定長ts.Write 固定トータルヘッダ

    '固定長黒伝データを出力
    固定長ts.Write 固定トータルヘッダ

    '固定長黒伝トレーラを出力
    固定長ts.Write 固定トータルヘッダ


    '可変長ヘッダ（タブ区切り、改行有）
    TSVts.WriteLine Join_Range(Range("D16:F16"), vbTab)
    
    '可変長データ（タブ区切り、改行有）
    TSVts.WriteLine Join_Range(Range("D22:F22"), vbTab)
'    TSVts.WriteLine Range("D22").Value & vbTab & Range("E22").Value & vbTab & Range("F22").Value
    
    '可変長トレーラ（タブ区切り、改行有）
    TSVts.WriteLine Join_Range(Range("D27:F27"), vbTab)
'    TSVts.WriteLine Range("D27").Value & vbTab & Range("E27").Value & vbTab & Range("F27").Value
    
        
    '赤伝ヘッダ
    '赤伝データ
    '赤伝トレーラ
    
    'トータルエンド
    
    
    
    
    '-----------------------------------------------------------------
    ' 指定ファイルをCLOSE
    固定長ts.Close
    TSVts.Close
    
    Set 固定長ts = Nothing
    Set TSVts = Nothing

End Sub

Private Function 固定トータルヘッダ() As String
    '-----------------------------------------------------------------------------------------------
    Dim strRec As String                                            ' レコードテキスト
    
    'L12～M12までを繋げる
    strRec = Join_Range(Range("L12:M12"), "")

    
    固定トータルヘッダ = strRec
    
End Function

Function Join_Range(対象セルリスト As Range, 区切り文字 As String) As String
    Dim cell As Range
    
    For Each cell In 対象セルリスト.Cells
        Join_Range = Join_Range & 区切り文字 & cell.Value
    Next
    
    Join_Range = Mid(Join_Range, Len(区切り文字) + 1)
End Function