エクセルVBAで固定長CSVを作成したい

Question

エクセルVBAで固定長CSVを作成したい

各セルを順に操作し、文字列（半角のみ）の列は後ろにスペースを必要数埋め、数値の列はアポストロフィと0で埋めることで、シート上の見映えとしては固定長を実現できました。

困っているのは、それを保存するときにどうしてもコンマ区切りCSVになってしまうことです（数値の前のアポストロフィは消えている点はよかったです）。

                ThisWorkbook.Activate
                SoukinSt.Visible = True
                SoukinSt.Select
                SoukinSt.Copy '名前を付け、ファイル形式も決めて特定の場所に保存する。
                ActiveWorkbook.ActiveSheet.Range("A1").Select
                    Application.DisplayAlerts = False
                    ActiveWorkbook.SaveAs fileName:=fn, FileFormat:=xlCSV
                    ActiveWorkbook.Close
                ThisWorkbook.Activate

このように保存しています。

現状は、手作業で、いったんコンマ区切りCSVで保存したそのファイルをメモ帳で開きコンマを""で置換して保存することで目的のファイルを得ていますが、ここまでも含めてVBAに任せたいです。

どのような方法がありえるでしょうか？

Comments

[tatsu99]

カンマ区切りをしたくないということでしょうか。
タブ区切りになりますが、
FileFormat:=xlCSV　を
FileFormat:=xlCurrentPlatformText
にしてはいかがでしょうか。

[y_repres]

ありがとうございます。
しかし、希望はカンマもタブでも区切らずただひたすら区切りのないデータが続き改行だけするテキストファイル（拡張しはcsv）なのです。

[tatsu99]

そうなると、saveasメソッドではなく、直接ファイルへ1行ずつ書き込むしかないですね。
考え方がガラッと変わります。

[Zuishin]

http://jinichiblog.com/pc/excel/post-407/

拡張子を変えてみては？

[y_repres]

ありがとうごごいます。
できればシート上で作成し外部保存という流れでやりたいので、それが難しいようなら直接ファイルに書き込む、拡張子を変えて出力しあとで拡張子を変更、というのも考えてみたいと思います。
ありがとうございました。

Answer 1

CSVはカンマ区切りテキストのことなので、列はカンマで区切られますね。

別シートに各列を1列に連結したデータを作成してそれをテキスト保存すればどうでしょう。

別シートに各列を連結する式を設定するとか、

各セルを順に操作し、文字列（半角のみ）の列は後ろにスペースを必要数埋め、数値の列はアポストロフィと0で埋めることで、シート上の見映えとしては固定長を実現できました。

これをVBAでしているなら、この操作をするときに各列を&で結合して別シートに代入するとか。

Comments

[y_repres]

ありがとうございました！
すべてA列だけで作成し保存するとは、まったく考えてませんでした。
助かります。ありがとうございました。

Answer 2

既に締め切ってますが、テキスト出力するサンプルです。
出力対象のシート名：Sheet1
出力ファイル名：data.csv
出力先のフォルダ：マクロのブックの格納フォルダと同じ個所
最大行はA列最終行で決定
最大列は1行最終列で決定
となっています。あなたの環境に合わせて、適切に変えてください。

Public Sub テキスト出力()
    Dim fn As String
    Dim maxrow As Long
    Dim maxcol As Long
    Dim ws As Worksheet
    Dim wrow As Long
    Dim wcol As Long
    Dim lstr As String
    Set ws = Worksheets("Sheet1")
    fn = ThisWorkbook.path & "\" & "data.csv"
    maxrow = ws.Cells(Rows.Count, 1).End(xlUp).Row             '1列目の最終行を求める
    maxcol = ws.Cells(1, Columns.Count).End(xlToLeft).Column   '1行目の最終列を求める
    Open fn For Output As #1
    For wrow = 1 To maxrow
        lstr = ""
        For wcol = 1 To maxcol
            lstr = lstr & ws.Cells(wrow, wcol).Value
        Next
        Print #1, lstr
    Next
    Close #1
    MsgBox ("完了")
End Sub