CSVファイル作成ツールをExcel VBAで作ってみた
業務で複数のCSVをDBに取り込むテストを行う機会があったので、今後のためにCSV作成をツール化しようと思い立った。
下図が完成したツールの様子。データシートに各種条件とデータを設定する。
文字コードシートでは、データシートの文字コードのコンボボックスから選択可能となる文字コードの一覧を設定しておく。
データシートの実行ボタンを押すと、このツールと同じ場所にCSVが出力される。
下図は、出力されたCSVをサクラエディタで開いたもの。
ツールで指定した囲み文字や、文字コードと改行コードに従って出力されていることを確認できる（赤枠参照）。
BOM無しで出力されていることの確認方法は、サクラエディタの場合、名前をつけて保存ダイアログにてBOMのチェックが付いているかどうかで判断できる。
さてソースコードだが、ネットのいろんなところで紹介されているので、詳細説明は省略してコードだけ残しておく。
まず「データ」シートモジュールでは、ボタン押下時に標準モジュールの関数などをコールするだけとした（下図参照）。
※CommandButton1は実行ボタン、CommanButton2は文字コードリスト再読み込みボタンのオブジェクト名。
標準モジュールは以下のようにコーディングした。
Auto_Openは、ツール起動時に自動で実行されるもの。
文字コードシートから文字コードのリストを読み込んで、データシートの文字コードコンボボックスにセットしている。
文字コードシートに手を加えたときに、それを反映させるため、文字コードリスト再読み込みボタンにも紐づけている。
outputがCSV出力コードの本体だが、説明は省略する。（各コントロールのオブジェクト名の説明を端折るが、VBA初心者でなければ当たりは付くはず）
1Option Explicit
2
3Sub Auto_Open()
4 Dim maxrow As Integer, i As Long
5 Dim chrSt As Object, datSt As Object
6 Set datSt = Worksheets("データ")
7 Set chrSt = Worksheets("文字コード")
8 datSt.ComboBox1.Value = ""
9 maxrow = chrSt.Cells(Rows.Count, 1).End(xlUp).Row
10 For i = 1 To maxrow
11 datSt.ComboBox1.AddItem chrSt.Range("A" & i).Value
12 Next i
13End Sub
14
15Sub output()
16 ' [参照設定] Microsoft ActiveX Data Objects 6.1 Library
17 Dim p_stream As ADODB.Stream
18 Dim maxrow As Long, maxcol As Long
19 Dim i As Long, j As Long
20 Dim startCol As Long
21 Dim lineStr As String
22 Dim enclose As String
23 Dim datSt As Object
24
25 On Error GoTo err
26
27 Set datSt = Worksheets("データ")
28 Set p_stream = New ADODB.Stream
29 maxrow = datSt.Cells(Rows.Count, 2).End(xlUp).Row
30 maxcol = datSt.Cells(2, Columns.Count).End(xlToLeft).Column
31
32 'ヘッダー出力判定
33 If datSt.CheckBox1.Value Then
34 startCol = 2
35 Else
36 startCol = 3
37 End If
38
39 ' 出力データ有無判定
40 If startCol > maxcol Then
41 MsgBox "出力するデータがありません"
42 Exit Sub
43 End If
44
45 ' 文字コード設定チェック
46 If Len(Trim(datSt.ComboBox1.Value)) = 0 Then
47 MsgBox "文字コードをリストより選択してください"
48 Exit Sub
49 End If
50
51 ' 囲み文字取得
52 enclose = Trim(datSt.TextBox2.Value)
53
54 With p_stream
55 ' 文字コード設定
56 .Charset = datSt.ComboBox1.Value
57
58 .Type = ADODB.StreamTypeEnum.adTypeText
59
60 ' 改行コード判定
61 If datSt.OptionButton1.Value Then
62 .LineSeparator = LineSeparatorEnum.adLF
63 ElseIf datSt.OptionButton2.Value Then
64 .LineSeparator = LineSeparatorEnum.adCR
65 Else
66 .LineSeparator = LineSeparatorEnum.adCRLF
67 End If
68
69 ' オープン
70 .Open
71
72 ' 出力データ生成
73 For j = startCol To maxcol
74 lineStr = ""
75 For i = 3 To maxrow
76 lineStr = lineStr & enclose & datSt.Cells(i, j).Value & enclose & ","
77 Next i
78 ' 末尾の余分なカンマとを削除
79 lineStr = Mid(lineStr, 1, Len(lineStr) - 1)
80 ' 文字列出力
81 .WriteText lineStr, ADODB.StreamWriteEnum.adWriteLine
82 Next j
83
84 ' BOMなしの場合
85 If Not datSt.CheckBox2.Value Then
86 ' タイプをバイナリにして、先頭の3バイトをスキップ
87 .Position = 0
88 .Type = ADODB.StreamTypeEnum.adTypeBinary ' タイプ変更するにはPosition = 0である必要がある
89 .Position = 3
90 ' 一時格納用
91 Dim p_byteData() As Byte
92 p_byteData = .Read
93 .Close ' 一旦閉じて
94 .Open ' 再度開いて
95 .Write p_byteData ' ストリームに書き込む
96 End If
97
98 .SaveToFile ThisWorkbook.Path & "¥" & datSt.TextBox1.Value, ADODB.SaveOptionsEnum.adSaveCreateOverWrite
99 .Close
100 End With
101 MsgBox "出力が完了しました"
102 Exit Sub
103
104err:
105 MsgBox "エラーが発生しました!" & vbCrLf & "Err.Number=[" & err.Number & "], Err.Description=[" & err.Description & "]"
106End Sub