他の業務システムに引き渡す目的でCSV形式ファイルを作成することは多いと思います。
システム間の受け渡し用のCSV形式ファイルは仕様が単一ではありません。
システム間の受け渡しを行なうためのCSV形式ファイルを作成する側であったとして、単にExcel上に項目を並べて、
「名前を付けて保存」で「CSV (カンマ区切り) (*.csv)」の形式で保存させると、拡張子が「*.CSV」になったファイルは作成されますが、
インタフェースの仕様に合った形式や項目数で保存されるとは限らないということを知っておく必要があります。
但し、近年では「Excelから保存させたCSV」というものがCSV形式ファイルとして「市民権」を得てきているようです。 会計や勤怠・給与など企業ではクラウドサービスを利用するケースが増えていますが、マスタデータなどでCSV形式ファイルが用いられます。
ワークシートから名前を付けて保存でCSV形式ファイルに保存させるというマクロであれば自動記録でもできるわけですが、 できるだけ汎用的なものを用意しておいて、繰り返しの利用にも対応できるようにしようというのがこのページの目的です。
但し、近年では「Excelから保存させたCSV」というものがCSV形式ファイルとして「市民権」を得てきているようです。 会計や勤怠・給与など企業ではクラウドサービスを利用するケースが増えていますが、マスタデータなどでCSV形式ファイルが用いられます。
ワークシートから名前を付けて保存でCSV形式ファイルに保存させるというマクロであれば自動記録でもできるわけですが、 できるだけ汎用的なものを用意しておいて、繰り返しの利用にも対応できるようにしようというのがこのページの目的です。
- まずはテストデータを見てみます。
-
(この画像をクリックすると、このページのサンプルがダウンロードができます。)
この画像か下の「ダウンロード」ボタンからダウンロードし解凍していただいた中に「CSVTEST.xlsx」があります。 手始めはこれを元にCSV形式ファイルを作成してみます。 ご覧のようにB列はセル内改行があったり、文字列中にカンマやダブルクォーテーションがあったりします。
まずはマクロを使わずにCSV形式ファイルに保存する方法で内容を確認してみます。 「CSVTEST.xlsx」を開いて「名前を付けて保存」で「CSV (カンマ区切り) (*.csv)」の形式を選択して保存させて下さい。 (Excel2016以降では「カンマ区切り」が「コンマ区切り」の表記に変わっています)
CSV形式ファイルができたらExcelではなく「メモ帳」かテキストエディタで開いてみて下さい。
Excelが作成したCSV形式ファイルはこんな感じです。 全体でカンマの数が統一されており、データがある最大列数に依存します。 セル内改行があったり、文字列中にカンマやダブルクォーテーションがあったりする場合はそのセルだけダブルクォーテーションで囲われ、 セル内のダブルクォーテーションは2つ連記に変更されています。
このCSV形式ファイルを単にExcelで開いた場合はA列の前ゼロが消えるなど完全に元には戻りませんが、 システム間の受け渡しはExcelでの受け取りを目的にしているのではないので、結果の中間確認はExcelではなく「メモ帳」かテキストエディタで行なって下さい。
- 先に「WriteCSVFile5.xlsm」を試してみます。
-
解凍した2つのマクロブックのうち「WriteCSVFile5.xlsm」を試してみます。
マクロの起動方法は2つとも同じで、起動ボタン等は用意していません。 CSV形式に変換する元となるワークブック(このサンプルでは「CSVTEST.xlsx」)をアクティブにした状態でマクロ「WriteCSVFile5.xlsm!WRITE_CSV_TEST」を起動します。
次にCSV形式ファイルのファイル名と保存場所を指定するダイアログが表示されます。 先ほどExcelから「名前を付けて保存」で「CSV (カンマ区切り) (*.csv)」の形式で保存させたのが 「CSVTEST1.csv」だったので「CSVTEST2.csv」としてみました。
これで「保存」ボタンをクリックするとCSV形式ファイルが保存されます。
エラーがなければこのように完了メッセージが表示されます。
モジュール上に指定項目があるのですが、初期値のままでこのようにCSV形式ファイルが出力され、 このテストデータではExcelから「名前を付けて保存」で「CSV (カンマ区切り) (*.csv)」の形式で保存させた ものと全く同じ内容でした。
- では「WriteCSVFile5.xlsm」のソースコードです。
-
「Module1」です。これはサンプルであり、利用シーンに応じて変更していただく必要があります。
クラス側の紹介は一番最後にします。
実際のCSV形式ファイル出力はクラス側が行なうので、「Module1」ではクラスを呼び出すまでの作業と、 クラス側の処理結果を行なっています。'*************************************************************************************************** ' CSV形式テキストファイル書き出すサンプル Module1(Module) ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** ' [参照設定] ' ・Microsoft Scription Runtime ' ・Windows Script Host Object Model '*************************************************************************************************** '変更日付 Rev 変更履歴内容------------------------------------------------------------------------> '19/12/22(1.00)新規作成 '*************************************************************************************************** Option Explicit '=================================================================================================== Public Const g_cnsTitle As String = "CSV形式テキストファイル書き出すサンプル" '--------------------------------------------------------------------------------------------------- ' CSV形式指定項目 Private Const g_cnsCntColumns As Long = 0 ' 列数(0=先頭行で自動判定) Private Const g_cnsFirstRow As Long = 1 ' 読出し先頭行番号(0不可,見出し含む) Private Const g_cnsFirstCol As Long = 1 ' 読出し先頭カラム番号(0不可) Private Const g_cnsCntMidashiRow As Long = 1 ' 見出し行数 Private Const g_cnsColCntMaxRows As Long = 1 ' 最終行判定列番号(0不可) Private Const g_cnsUseMidashi As Boolean = True ' 見出し出力有無(行数0時はFalse) Private Const g_cnsUseUnicode As Boolean = False ' Unicode指定 '*************************************************************************************************** ' ■■■ ユーザー起動処理 ■■■ '*************************************************************************************************** '* 処理名 ：WRITE_CSV_TEST '* 機能 ：CSV形式テキストファイル書き出すサンプル '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2019年12月22日 '* 作成者 ：井上 治 '* 更新日 ：2019年12月22日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Public Sub WRITE_CSV_TEST() '----------------------------------------------------------------------------------------------- Dim objShell As WshShell ' WshShell Dim objClass As clsWriteCsvFile5 ' CSV出力クラス Dim strCurrPathSV As String ' カレントフォルダ退避 Dim strFilename As String ' ファイル名 Dim vntFilename As Variant ' ファイル名(受け取り) ' アクティブシートチェック If ActiveWorkbook.Name = ThisWorkbook.Name Then MsgBox "CSV出力させるワークシートをアクティブにした状態で起動して下さい。", _ vbExclamation, g_cnsTitle Exit Sub End If '----------------------------------------------------------------------------------------------- Set objShell = New WshShell strCurrPathSV = objShell.CurrentDirectory objShell.CurrentDirectory = ThisWorkbook.Path ' ファイル名受け取り vntFilename = Application.GetSaveAsFilename("SAMPLE.csv", _ "CSV形式ファイル (*.csv),*.csv", , _ "出力ファイル名の指定") objShell.CurrentDirectory = strCurrPathSV ' キャンセルは終了 If VarType(vntFilename) = vbBoolean Then Exit Sub strFilename = vntFilename '----------------------------------------------------------------------------------------------- ' CSV形式テキストファイル書き出しクラス Set objClass = New clsWriteCsvFile5 With objClass .prpCntColumns = g_cnsCntColumns ' 項目カラム数 .prpFirstRow = g_cnsFirstRow ' 読出し先頭行番号 .prpFirstCol = g_cnsFirstCol ' 読出し先頭カラム番号 .prpCntMidashiRow = g_cnsCntMidashiRow ' 見出し行数 .prpColCntMaxRows = g_cnsColCntMaxRows ' 最終行判定列番号 .prpUseMidashi = g_cnsUseMidashi ' 見出し出力有無 .prpUseUnicode = g_cnsUseUnicode ' Unicode指定 .prpFilename = strFilename ' 出力ファイル名 ' 実際のCSV出力処理 If Not .WriteCsvFile5(ActiveSheet) Then ' エラー表示 MsgBox .prpErrMSG, vbCritical, g_cnsTitle Else ' 終了表示 MsgBox "処理完了しました。", vbInformation, g_cnsTitle End If End With End Sub '----------------------------------------<< End of Source >>----------------------------------------
このサンプルではアクティブシートの内容をCSV形式ファイルに出力するので、マクロブック側がアクティブになっている場合はエラーにするというのが 最初の「アクティブシートチェック」です。
次の点線で挟まれた範囲がCSV形式ファイルの出力ファイル名の指定部分です。 この方法は次ページ「フォルダの参照」の「Button5_Click」で説明しているのと同様の方法で マクロブックのフォルダをデフォルトにして「名前を付けて保存」ダイアログを表示させます。 これはカレントフォルダを変更する方法で行なうため、直前のカレントフォルダを一旦退避用変数に確保して 「名前を付けて保存」ダイアログの動作後に元に戻しています。
その後が実際のCSVファイル出力クラスの呼び出し部分になります。
実際のCSVファイル出力処理「WriteCsvFile5」の前にパラメータ要素の8項目をプロパティでセットしています。 このうち「出力CSVファイル名(prpFilename)」以外は処理上で固定的な要素と考えられるので以下のようにモジュール定数としています。
「出力CSVファイル名(prpFilename)」をプロパティ側に持って行っているのは、 複数ワークシートから同一ファイル名に出力するケースを想定しているためで、今回のサンプルでは実際のCSVファイル出力処理「WriteCsvFile5」の第1引数は「ActiveSheet」としておりアクティブシートのみですが、 特定のワークシートを指定することが可能で、Optionの第2引数(blnAppend)にTrueをセットすれば追加モードで出力されるようになっています。プロパティ名 今回の定数名 内 容 prpCntColumns g_cnsCntColumns ワークシート側の項目カラム数です。0の時は先頭行の項目数で自動判定されます。
先頭行が「見出し」であれば見出し項目数で決定されます。
見出しがない場合は先頭行の項目数は右寄りの項目がブランクかどうかでブレるので0ではなく項目数を指定して下さい。prpFirstRow g_cnsFirstRow ワークシート側の見出しを含む読み出し先頭行です。通常は1です。
「見出し」をCSV側に出力するかどうか及び見出し行数は別項目で指定できるので単に読み出し先頭行として指定して下さい。prpFirstCol g_cnsFirstCol ワークシート側の読み出し先頭カラムです。通常は1です。
実際にCSV側に出力するセル範囲の左に余分な列がある場合は値を変更することでこれを避けることができます。prpCntMidashiRow g_cnsCntMidashiRow ワークシート側の見出し行数です。 prpColCntMaxRows g_cnsColCntMaxRows ワークシート側でデータ最終行を判定するカラムを指定します。必ず値がある列番号を指定して下さい。 prpUseMidashi g_cnsUseMidashi 見出し行をCSV側に出力するかどうかの指定です。 prpUseUnicode g_cnsUseUnicode CSV側の文字コードをUNICODEにするかの指定です。
- 次は「WriteCSVFile4.xlsm」です。
-
サンプルの操作上は「WriteCSVFile5.xlsm」と全く同じなのでここでは画像はありませんが、
パラメータは細かく指定できるようになっています。
先に「Module1」を紹介します。
出力CSVファイル名については前項目と同じなので、それ以外のプロパティ項目を説明します。'*************************************************************************************************** ' CSV形式テキストファイル書き出すサンプル Module1(Module) ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** ' [参照設定] ' ・Microsoft Scription Runtime ' ・Windows Script Host Object Model '*************************************************************************************************** '変更日付 Rev 変更履歴内容------------------------------------------------------------------------> '19/12/22(1.00)新規作成 '*************************************************************************************************** Option Explicit '=================================================================================================== Public Const g_cnsTitle As String = "CSV形式テキストファイル書き出すサンプル" '--------------------------------------------------------------------------------------------------- ' CSV形式指定項目 Private Const g_cnsCntColumns As Long = 0 ' 列数(0=先頭行で自動判定) Private Const g_cnsFirstRow As Long = 1 ' 読出し先頭行番号(0不可,見出し含む) Private Const g_cnsFirstCol As Long = 1 ' 読出し先頭カラム番号(0不可) Private Const g_cnsCntMidashiRow As Long = 1 ' 見出し行数 Private Const g_cnsColCntMaxRows As Long = 1 ' 最終行判定列番号(0不可) Private Const g_cnsUseUnicode As Boolean = False ' Unicode指定 '------------------------------------------------- ' ■見出し出力方法 Private Const g_cnsUseMidashi As Long = 8 ' 見出し出力方法 ' ※｢見出し出力方法｣指定値の説明 ' -1=見出しなし(先頭行からデータとして編集) ' 0=先頭行のみセパレータのみ(下記「カラム単位の編集」は無視) ' 2=先頭行は全て「"」囲い(下記「カラム単位の編集」は無視) ' 4=先頭行は全て「'」囲い(下記「カラム単位の編集」は無視) ' 8=自動判定(セル内改行､「"」､「,」有りは「"」囲い) ' 9=自動判定(セル内改行､「'」､「,」有りは「'」囲い) '------------------------------------------------- ' ■カラム単位編集方法(カラム位置ごと) ' カラム位置⇒ ....*....1....*....2....*....3....*....4....*....5 Private Const g_cnsColEdit = "28111000000000000000000000000000000000000000000000" ' ※｢カラム単位編集方法｣指定値の説明 ' 0=セパレータのみ ' 1=数値(ブランク､非数値はゼロ出力) ' 2=文字列(「"」囲い：無条件) ' 3=文字列(「"」囲い：ブランクを除く) ' 4=文字列(「'」囲い：無条件) ' 5=文字列(「'」囲い：ブランクを除く) ' 6=日付(「#」囲い：ブランクを除く) ' 7=日付(「"」囲い：ブランクを除く) ' 8=自動判定(セル内改行､「"」､「,」有りは「"」囲い) ' 9=自動判定(セル内改行､「'」､「,」有りは「'」囲い) '*************************************************************************************************** ' ■■■ ユーザー起動処理 ■■■ '*************************************************************************************************** '* 処理名 ：WRITE_CSV_TEST '* 機能 ：CSV形式テキストファイル書き出すサンプル '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2019年12月22日 '* 作成者 ：井上 治 '* 更新日 ：2019年12月22日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Public Sub WRITE_CSV_TEST() '----------------------------------------------------------------------------------------------- Dim objShell As WshShell ' WshShell Dim objClass As clsWriteCsvFile4 ' CSV出力クラス Dim strCurrPathSV As String ' カレントフォルダ退避 Dim strFilename As String ' ファイル名 Dim vntFilename As Variant ' ファイル名(受け取り) ' アクティブシートチェック If ActiveWorkbook.Name = ThisWorkbook.Name Then MsgBox "CSV出力させるワークシートをアクティブにした状態で起動して下さい。", _ vbExclamation, g_cnsTitle Exit Sub End If '----------------------------------------------------------------------------------------------- Set objShell = New WshShell strCurrPathSV = objShell.CurrentDirectory objShell.CurrentDirectory = ThisWorkbook.Path ' ファイル名受け取り vntFilename = Application.GetSaveAsFilename("SAMPLE.csv", _ "CSV形式ファイル (*.csv),*.csv", , _ "出力ファイル名の指定") objShell.CurrentDirectory = strCurrPathSV ' キャンセルは終了 If VarType(vntFilename) = vbBoolean Then Exit Sub strFilename = vntFilename '----------------------------------------------------------------------------------------------- ' CSV形式テキストファイル書き出しクラス Set objClass = New clsWriteCsvFile4 With objClass .prpCntColumns = g_cnsCntColumns ' 項目カラム数 .prpFirstRow = g_cnsFirstRow ' 読出し先頭行番号 .prpFirstCol = g_cnsFirstCol ' 読出し先頭カラム番号 .prpCntMidashiRow = g_cnsCntMidashiRow ' 見出し行数 .prpColCntMaxRows = g_cnsColCntMaxRows ' 最終行判定列番号 .prpUseMidashi = g_cnsUseMidashi ' 見出し出力指定 .prpUseUnicode = g_cnsUseUnicode ' Unicode指定 .prpColEdit = g_cnsColEdit .prpFilename = strFilename ' 出力ファイル名 ' 実際のCSV出力処理 If Not .WriteCsvFile4(ActiveSheet) Then ' エラー表示 MsgBox .prpErrMSG, vbCritical, g_cnsTitle Else ' 終了表示 MsgBox "処理完了しました。", vbInformation, g_cnsTitle End If End With End Sub '----------------------------------------<< End of Source >>----------------------------------------
細かい指定ができますが、反面、指定を誤ると誤動作に繋がるので充分にテストを行なってご利用下さい。プロパティ名 今回の定数名 内 容 prpCntColumns g_cnsCntColumns ワークシート側の項目カラム数です。0の時は先頭行の項目数で自動判定されます。
先頭行が「見出し」であれば見出し項目数で決定されます。
見出しがない場合は先頭行の項目数は右寄りの項目がブランクかどうかでブレるので0ではなく項目数を指定して下さい。prpFirstRow g_cnsFirstRow ワークシート側の見出しを含む読み出し先頭行です。通常は1です。
「見出し」をCSV側に出力するかどうか及び見出し行数は別項目で指定できるので単に読み出し先頭行として指定して下さい。prpFirstCol g_cnsFirstCol ワークシート側の読み出し先頭カラムです。通常は1です。
実際にCSV側に出力するセル範囲の左に余分な列がある場合は値を変更することでこれを避けることができます。prpCntMidashiRow g_cnsCntMidashiRow ワークシート側の見出し行数です。 prpColCntMaxRows g_cnsColCntMaxRows ワークシート側でデータ最終行を判定するカラムを指定します。必ず値がある列番号を指定して下さい。 prpUseMidashi g_cnsUseMidashi 見出し行をCSV側に出力するかどうかの指定です。
出力有無だけでなく「どのように出力するか」を以下の中から指定します。
-1=見出しなし(先頭行からデータとして編集)
0=先頭行のみセパレータのみ(下記「カラム単位の編集」は無視)
2=先頭行は全て「"」囲い(下記「カラム単位の編集」は無視)
4=先頭行は全て「'」囲い(下記「カラム単位の編集」は無視)
8=自動判定(セル内改行､「"」､「,」有りは「"」囲い)
9=自動判定(セル内改行､「'」､「,」有りは「'」囲い)
prpUseUnicode g_cnsUseUnicode CSV側の文字コードをUNICODEにするかの指定です。 prpColEdit g_cnsColEdit カラム単位編集方法指定
カラムごとのCSV側への編集方法の指定です。スケール状の文字列で指定します。
0=セパレータのみ
1=数値(ブランク､非数値はゼロ出力)
2=文字列(「"」囲い：無条件)
3=文字列(「"」囲い：ブランクを除く)
4=文字列(「'」囲い：無条件)
5=文字列(「'」囲い：ブランクを除く)
6=日付(「#」囲い：ブランクを除く)
7=日付(「"」囲い：ブランクを除く)
8=自動判定(セル内改行､「"」､「,」有りは「"」囲い)
9=自動判定(セル内改行､「'」､「,」有りは「'」囲い)
ファイル名指定や複数シートでの動作については前項と同じです。
- 「WriteCSVFile5.xlsm」のクラス側のソースコードです。
-
ダウンロードのジャンルではこれらの詳細なソースコードを理解しなくても目的を達成できるような紹介の方法を採っているつもりですが、
この中身まで理解しようとするような学習目的の方のためにクラス側のソースコードを紹介します。
'*************************************************************************************************** ' CSV形式テキストファイル書き出しクラス clsWriteCsvFile5(Class) ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** ' [参照設定] ' ・Microsoft Scription Runtime '*************************************************************************************************** '変更日付 Rev 変更履歴内容------------------------------------------------------------------------> '19/12/22(1.00)新規作成 '*************************************************************************************************** Option Explicit '=================================================================================================== ' 共通定数 Private Const g_cnsComm As String = "," Private Const g_cnsDQ As String = """" '--------------------------------------------------------------------------------------------------- ' 呼び元から引き渡される変数 Private g_lngCntColumns As Long ' 項目カラム数 Private g_lngFirstRow As Long ' 読出し先頭行番号 Private g_lngFirstCol As Long ' 読出し先頭カラム番号 Private g_lngCntMidashiRow As Long ' 見出し行数 Private g_lngColCntMaxRows As Long ' 最終行判定列番号 Private g_blnUseMidashi As Boolean ' 見出し出力有無 Private g_blnUseUnicode As Boolean ' Unicode指定 Private g_strSepChar As String ' 項目境界文字 Private g_strFilename As String ' 出力ファイル名 Private g_strErrMSG As String ' エラーメッセージ '*************************************************************************************************** ' ■■■ 共通サブ処理 ■■■ '*************************************************************************************************** '* 処理名 ：Class_Initialize '* 機能 ：クラス初期処理 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2019年12月22日 '* 作成者 ：井上 治 '* 更新日 ：2019年12月22日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Sub Class_Initialize() '----------------------------------------------------------------------------------------------- g_lngCntColumns = 0 g_lngFirstRow = 1 g_lngCntMidashiRow = 1 g_lngColCntMaxRows = 1 g_blnUseMidashi = True g_blnUseUnicode = False g_strSepChar = g_cnsComm g_strErrMSG = "" End Sub '*************************************************************************************************** ' ■■■ ワークシート側からの呼び出し処理 ■■■ '*************************************************************************************************** '* 処理名 ：WriteCsvFile5 '* 機能 ：CSV形式テキストファイル出力 '--------------------------------------------------------------------------------------------------- '* 返り値 ：処理成否(Boolean) '* 引数 ：Arg1 = 処理対象シート(Object) '* Arg2 = 追記出力指定(Boolean) ※Option '--------------------------------------------------------------------------------------------------- '* 作成日 ：2019年12月22日 '* 作成者 ：井上 治 '* 更新日 ：2019年12月22日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項：引数パラメータの条理チェックは行なっていない(正しい前提) '*************************************************************************************************** Friend Function WriteCsvFile5(ByVal objSh As Worksheet, _ Optional ByVal blnAppend As Boolean = False) As Boolean '----------------------------------------------------------------------------------------------- Dim objFso As FileSystemObject ' FileSystemObject Dim objTs As TextStream ' TextStream Dim lngRow As Long ' 行INDEX Dim lngRowMax As Long ' 最終行INDEX Dim blnOpen As Boolean ' ファイルOPEN判定 WriteCsvFile5 = False On Error GoTo WriteCsvFile5_ERROR Set objFso = New FileSystemObject ' 出力ファイルOPEN Set objTs = objFso.CreateTextFile(g_strFilename, True, g_blnUseUnicode) blnOpen = True With objSh ' 保護解除(PW不対応) If .ProtectContents Then .Unprotect ' フィルタ解除 If .FilterMode Then .ShowAllData ' 先頭行設定 lngRow = g_lngFirstRow ' 項目カラム数がゼロの場合は先頭行で判定 If g_lngCntColumns = 0 Then g_lngCntColumns = .Cells(lngRow, .Columns.Count).End(xlToLeft).Column End If ' 見出し出力無しの時は見出し行数を加算(見出しSKIP) If Not g_blnUseMidashi Then lngRow = lngRow + g_lngCntMidashiRow End If ' 最終行判定 lngRowMax = .Cells(.Rows.Count, g_lngColCntMaxRows).End(xlUp).Row ' 最終行まで繰り返す Do While lngRow <= lngRowMax ' 1行分のCSV編集・出力 objTs.WriteLine FP_EditCsvRec(objSh, lngRow) ' 次の行へ lngRow = lngRow + 1 Loop End With WriteCsvFile5 = g_strErrMSG = "" GoTo WriteCsvFile5_EXIT '=================================================================================================== ' エラートラップ WriteCsvFile5_ERROR: Call GP_AppendMessage2(Err.Description) '=================================================================================================== ' 終了 WriteCsvFile5_EXIT: ' 出力ファイルCLOSE If blnOpen Then objTs.Close Set objFso = Nothing End Function '*************************************************************************************************** ' ■■■ サブ処理(Private) ■■■ '*************************************************************************************************** '* 処理名 ：FP_EditCsvRec '* 機能 ：1行分のCSV編集 '--------------------------------------------------------------------------------------------------- '* 返り値 ：1行分の編集結果(String) '* 引数 ：Arg1 = 処理対象シート(Object) '* Arg2 = 現在行INDEX(Long) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2019年12月22日 '* 作成者 ：井上 治 '* 更新日 ：2019年12月22日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Function FP_EditCsvRec(ByVal objSh As Worksheet, ByVal lngRow As Long) As String '----------------------------------------------------------------------------------------------- Dim lngCol As Long ' カラムINDEX Dim strRec As String ' CSVレコード With objSh ' 先頭カラム処理 strRec = FP_EditCsvFld(.Cells(lngRow, g_lngFirstCol).Value) lngCol = g_lngFirstCol + 1 ' 次カラム以降 Do While lngCol <= g_lngCntColumns ' 1セル分のCSV編集 strRec = strRec & g_strSepChar & FP_EditCsvFld(.Cells(lngRow, lngCol).Value) ' 次の列へ lngCol = lngCol + 1 Loop End With FP_EditCsvRec = strRec End Function '*************************************************************************************************** '* 処理名 ：FP_EditCsvFld '* 機能 ：1セル分のCSV編集 '--------------------------------------------------------------------------------------------------- '* 返り値 ：1セル分の編集結果(String) '* 引数 ：Arg1 = 現在セル値(Variant) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2019年12月22日 '* 作成者 ：井上 治 '* 更新日 ：2019年12月22日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Function FP_EditCsvFld(ByVal vntValue As Variant) As String '----------------------------------------------------------------------------------------------- Dim lngPos As Long ' 文字位置 Dim blnNeedDQ As Boolean ' ダブルクォーテーション囲い要否 Dim blnNewLine As Boolean ' セル内改行有無 Dim strFld As String ' セル入力項目値 Dim strFldO As String ' CSV出力項目値 Dim strChar As String * 1 ' 1文字 ' タイプ判定 Select Case True Case IsDate(vntValue) FP_EditCsvFld = CStr(vntValue) Case IsNumeric(vntValue) FP_EditCsvFld = CStr(vntValue) Case Else strFld = vntValue ' ブランクセルは終了 If Trim(strFld) = "" Then FP_EditCsvFld = "" Exit Function End If lngPos = 1 ' 1文字ずつ判定 Do While lngPos <= Len(strFld) strChar = Mid(strFld, lngPos, 1) ' 文字判定 Select Case strChar Case g_cnsDQ ' ダブルクォーテーション blnNeedDQ = True ' ダブルクォーテーションは連記 strFldO = strFldO & strChar Case g_cnsComm ' カンマ blnNeedDQ = True Case vbCr, vbLf ' 改行コード blnNewLine = True End Select strFldO = strFldO & strChar ' 次の文字へ lngPos = lngPos + 1 Loop ' セル内改行有無 If blnNewLine Then blnNeedDQ = True ' CrLfを一旦Lfのみに変換 strFldO = Replace(strFldO, vbCrLf, vbLf) ' Crのみを一旦Lfのみに変換 strFldO = Replace(strFldO, vbCr, vbLf) ' LfをCrLfに変換 strFldO = Replace(strFldO, vbLf, vbCrLf) End If ' ダブルクォーテーション囲い要否 If blnNeedDQ Then FP_EditCsvFld = g_cnsDQ & strFldO & g_cnsDQ Else FP_EditCsvFld = strFldO End If End Select End Function '*************************************************************************************************** '* 処理名 ：GP_AppendMessage2 '* 機能 ：エラーメッセージ累積 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 今回メッセージ(String) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2019年12月22日 '* 作成者 ：井上 治 '* 更新日 ：2019年12月22日 '* 更新者 ：井上 治 '* 機能説明：改行を付加して追加 '* 注意事項： '*************************************************************************************************** Private Sub GP_AppendMessage2(ByVal strAddMSG As String) '----------------------------------------------------------------------------------------------- If g_strErrMSG <> "" Then g_strErrMSG = g_strErrMSG & vbCrLf g_strErrMSG = g_strErrMSG & strAddMSG End Sub '*************************************************************************************************** ' ■■■ プロパティ ■■■ '*************************************************************************************************** ' 項目カラム数(Long) '--------------------------------------------------------------------------------------------------- Friend Property Let prpCntColumns(ByVal lngValue As Long) g_lngCntColumns = lngValue End Property '=================================================================================================== ' 読出し先頭行番号(Long) '--------------------------------------------------------------------------------------------------- Friend Property Let prpFirstRow(ByVal lngValue As Long) g_lngFirstRow = lngValue End Property '=================================================================================================== ' 読出し先頭カラム番号(Long) '--------------------------------------------------------------------------------------------------- Friend Property Let prpFirstCol(ByVal lngValue As Long) g_lngFirstCol = lngValue End Property '=================================================================================================== ' 見出し行数(Long) '--------------------------------------------------------------------------------------------------- Friend Property Let prpCntMidashiRow(ByVal lngValue As Long) g_lngCntMidashiRow = lngValue End Property '=================================================================================================== ' 最終行判定列番号(Long) '--------------------------------------------------------------------------------------------------- Friend Property Let prpColCntMaxRows(ByVal lngValue As Long) g_lngColCntMaxRows = lngValue End Property '=================================================================================================== ' 見出し出力有無(Boolean) '--------------------------------------------------------------------------------------------------- Friend Property Let prpUseMidashi(ByVal blnValue As Boolean) g_blnUseMidashi = blnValue End Property '=================================================================================================== ' Unicode指定(Boolean) '--------------------------------------------------------------------------------------------------- Friend Property Let prpUseUnicode(ByVal blnValue As Boolean) g_blnUseUnicode = blnValue End Property '=================================================================================================== ' 項目境界文字(String) '--------------------------------------------------------------------------------------------------- Friend Property Let prpSepChar(ByVal strValue As String) g_strSepChar = strValue End Property '=================================================================================================== ' 出力ファイル名(String) '--------------------------------------------------------------------------------------------------- Friend Property Let prpFilename(ByVal strValue As String) g_strFilename = strValue End Property '=================================================================================================== ' エラーメッセージ(String) '--------------------------------------------------------------------------------------------------- Friend Property Get prpErrMSG() As String prpErrMSG = g_strErrMSG End Property '----------------------------------------<< End of Source >>----------------------------------------
- 「WriteCSVFile4.xlsm」のクラス側のソースコードです。
-
'*************************************************************************************************** ' CSV形式テキストファイル書き出しクラス clsWriteCsvFile4(Class) ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** ' [参照設定] ' ・Microsoft Scription Runtime '*************************************************************************************************** '変更日付 Rev 変更履歴内容------------------------------------------------------------------------> '19/12/22(1.00)新規作成 '*************************************************************************************************** Option Explicit '=================================================================================================== ' 共通定数 Private Const g_cnsComm As String = "," Private Const g_cnsDQ As String = """" Private Const g_cnsSQ As String = "'" Private Const g_cnsSH As String = "#" '--------------------------------------------------------------------------------------------------- ' 呼び元から引き渡される変数 Private g_lngCntColumns As Long ' 項目カラム数 Private g_lngFirstRow As Long ' 読出し先頭行番号 Private g_lngFirstCol As Long ' 読出し先頭カラム番号 Private g_lngCntMidashiRow As Long ' 見出し行数 Private g_lngColCntMaxRows As Long ' 最終行判定列番号 Private g_blnUseUnicode As Boolean ' Unicode指定 Private g_strSepChar As String ' 項目境界文字 Private g_strFilename As String ' 出力ファイル名 '------------------------------------------------- ' ■見出し出力方法 Private g_lngUseMidashi As Long ' 見出し出力方法 ' ※｢見出し出力方法｣指定値の説明 ' -1=見出しなし(先頭行からデータとして編集) ' 0=先頭行のみセパレータのみ(下記「カラム単位の編集」は無視) ' 2=先頭行は全て「"」囲い(下記「カラム単位の編集」は無視) ' 4=先頭行は全て「'」囲い(下記「カラム単位の編集」は無視) ' 8=自動判定(セル内改行､「"」､「,」有りは「"」囲い) ' 9=自動判定(セル内改行､「'」､「,」有りは「'」囲い) '------------------------------------------------- ' ■カラム単位編集方法(テーブル) Private g_tblColEdit() As Long ' カラム単位編集方法 ' ※｢カラム単位編集方法｣指定値の説明 ' 0=セパレータのみ ' 1=数値(ブランク､非数値はゼロ出力) ' 2=文字列(「"」囲い：無条件) ' 3=文字列(「"」囲い：ブランクを除く) ' 4=文字列(「'」囲い：無条件) ' 5=文字列(「'」囲い：ブランクを除く) ' 6=日付(「#」囲い：ブランクを除く) ' 7=日付(「"」囲い：ブランクを除く) ' 8=自動判定(セル内改行､「"」､「,」有りは「"」囲い) ' 9=自動判定(セル内改行､「'」､「,」有りは「'」囲い) Private g_strErrMSG As String ' エラーメッセージ '*************************************************************************************************** ' ■■■ 共通サブ処理 ■■■ '*************************************************************************************************** '* 処理名 ：Class_Initialize '* 機能 ：クラス初期処理 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2019年12月22日 '* 作成者 ：井上 治 '* 更新日 ：2019年12月22日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Sub Class_Initialize() '----------------------------------------------------------------------------------------------- g_lngCntColumns = 0 g_lngFirstRow = 1 g_lngCntMidashiRow = 1 g_lngColCntMaxRows = 1 g_lngUseMidashi = 8 g_blnUseUnicode = False g_strSepChar = g_cnsComm ReDim g_tblColEdit(0) g_strErrMSG = "" End Sub '*************************************************************************************************** ' ■■■ ワークシート側からの呼び出し処理 ■■■ '*************************************************************************************************** '* 処理名 ：WriteCsvFile4 '* 機能 ：CSV形式テキストファイル出力 '--------------------------------------------------------------------------------------------------- '* 返り値 ：処理成否(Boolean) '* 引数 ：Arg1 = 処理対象シート(Object) '* Arg2 = 追記出力指定(Boolean) ※Option '--------------------------------------------------------------------------------------------------- '* 作成日 ：2019年12月22日 '* 作成者 ：井上 治 '* 更新日 ：2019年12月22日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項：引数パラメータの条理チェックは行なっていない(正しい前提) '*************************************************************************************************** Friend Function WriteCsvFile4(ByVal objSh As Worksheet, _ Optional ByVal blnAppend As Boolean = False) As Boolean '----------------------------------------------------------------------------------------------- Dim objFso As FileSystemObject ' FileSystemObject Dim objTs As TextStream ' TextStream Dim lngRow As Long ' 行INDEX Dim lngRowDTop As Long ' データ開始行INDEX Dim lngRowMax As Long ' 最終行INDEX Dim blnOpen As Boolean ' ファイルOPEN判定 WriteCsvFile4 = False On Error GoTo WriteCsvFile4_ERROR Set objFso = New FileSystemObject ' 出力ファイルOPEN Set objTs = objFso.CreateTextFile(g_strFilename, True, g_blnUseUnicode) blnOpen = True With objSh ' 保護解除(PW不対応) If .ProtectContents Then .Unprotect ' フィルタ解除 If .FilterMode Then .ShowAllData ' 先頭行設定 lngRow = g_lngFirstRow ' 項目カラム数がゼロの場合は先頭行で判定 If g_lngCntColumns = 0 Then g_lngCntColumns = .Cells(lngRow, .Columns.Count).End(xlToLeft).Column End If ' 見出し出力無しの時は見出し行数を加算(見出しSKIP) If g_lngUseMidashi < 0 Then lngRow = lngRow + g_lngCntMidashiRow lngRowDTop = lngRow Else lngRowDTop = lngRow + g_lngCntMidashiRow End If ' 最終行判定 lngRowMax = .Cells(.Rows.Count, g_lngColCntMaxRows).End(xlUp).Row ' 見出し編集(データ開始行の前まで) Do While lngRow < lngRowDTop ' 1行分のCSV編集・出力(見出し用) objTs.WriteLine FP_EditCsvMidashi(objSh, lngRow) ' 次の行へ lngRow = lngRow + 1 Loop ' 最終行まで繰り返す Do While lngRow <= lngRowMax ' 1行分のCSV編集・出力 objTs.WriteLine FP_EditCsvRec(objSh, lngRow) ' 次の行へ lngRow = lngRow + 1 Loop End With WriteCsvFile4 = g_strErrMSG = "" GoTo WriteCsvFile4_EXIT '=================================================================================================== ' エラートラップ WriteCsvFile4_ERROR: Call GP_AppendMessage2(Err.Description) '=================================================================================================== ' 終了 WriteCsvFile4_EXIT: ' 出力ファイルCLOSE If blnOpen Then objTs.Close Set objFso = Nothing End Function '*************************************************************************************************** ' ■■■ サブ処理(Private) ■■■ '*************************************************************************************************** '* 処理名 ：FP_EditCsvRec '* 機能 ：1行分のCSV編集 '--------------------------------------------------------------------------------------------------- '* 返り値 ：1行分の編集結果(String) '* 引数 ：Arg1 = 処理対象シート(Object) '* Arg2 = 現在行INDEX(Long) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2019年12月22日 '* 作成者 ：井上 治 '* 更新日 ：2019年12月22日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Function FP_EditCsvRec(ByVal objSh As Worksheet, ByVal lngRow As Long) As String '----------------------------------------------------------------------------------------------- Dim lngCol As Long ' カラムINDEX Dim strRec As String ' CSVレコード With objSh ' 先頭カラム処理 strRec = FP_EditCsvFld(.Cells(lngRow, g_lngFirstCol).Value, g_tblColEdit(g_lngFirstCol)) lngCol = g_lngFirstCol + 1 ' 次カラム以降 Do While lngCol <= g_lngCntColumns ' 1セル分のCSV編集 strRec = strRec & g_strSepChar & FP_EditCsvFld(.Cells(lngRow, lngCol).Value, _ g_tblColEdit(lngCol)) ' 次の列へ lngCol = lngCol + 1 Loop End With FP_EditCsvRec = strRec End Function '*************************************************************************************************** '* 処理名 ：FP_EditCsvMidashi '* 機能 ：1行分のCSV編集(見出し用) '--------------------------------------------------------------------------------------------------- '* 返り値 ：1行分の編集結果(String) '* 引数 ：Arg1 = 処理対象シート(Object) '* Arg2 = 現在行INDEX(Long) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2019年12月22日 '* 作成者 ：井上 治 '* 更新日 ：2019年12月22日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Function FP_EditCsvMidashi(ByVal objSh As Worksheet, ByVal lngRow As Long) As String '----------------------------------------------------------------------------------------------- Dim lngCol As Long ' カラムINDEX Dim strRec As String ' CSVレコード With objSh ' 先頭カラム処理 strRec = FP_EditCsvFld(.Cells(lngRow, g_lngFirstCol).Value, g_lngUseMidashi) lngCol = g_lngFirstCol + 1 ' 次カラム以降 Do While lngCol <= g_lngCntColumns ' 1セル分のCSV編集 strRec = strRec & g_strSepChar & FP_EditCsvFld(.Cells(lngRow, lngCol).Value, g_lngUseMidashi) ' 次の列へ lngCol = lngCol + 1 Loop End With FP_EditCsvMidashi = strRec End Function '*************************************************************************************************** '* 処理名 ：FP_EditCsvFld '* 機能 ：1セル分のCSV編集 '--------------------------------------------------------------------------------------------------- '* 返り値 ：1セル分の編集結果(String) '* 引数 ：Arg1 = 現在セル値(Variant) '* Arg2 = カラム編集方法(Long) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2019年12月22日 '* 作成者 ：井上 治 '* 更新日 ：2019年12月22日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Function FP_EditCsvFld(ByVal vntValue As Variant, _ ByVal lngColEdit As Long) As String '----------------------------------------------------------------------------------------------- Dim lngPos As Long ' 文字位置 Dim blnNeedDQ As Boolean ' ダブルクォーテーション囲い要否 Dim blnNewLine As Boolean ' セル内改行有無 Dim strFld As String ' セル入力項目値 Dim strFldO As String ' CSV出力項目値 Dim strChar As String * 1 ' 1文字 Dim strSepChar As String ' 文字列境界文字 ' 文字列境界文字 Select Case lngColEdit Case 4, 5, 9: strSepChar = g_cnsSQ Case Else: strSepChar = g_cnsDQ End Select strFld = vntValue ' カラム編集方法判別 Select Case lngColEdit Case 0 ' セパレータのみ FP_EditCsvFld = strFld Case 1 ' 数値(ブランク､非数値はゼロ出力) If IsNumeric(strFld) Then FP_EditCsvFld = strFld Else FP_EditCsvFld = "0" End If Case 2, 4 ' 文字列(「"」囲い：無条件) FP_EditCsvFld = strSepChar & strFld & strSepChar Case 3, 5, 7 ' 文字列(「"」囲い：ブランクを除く) If Trim(strFld) = "" Then FP_EditCsvFld = "" Else FP_EditCsvFld = strSepChar & strFld & strSepChar End If Case 6 ' 日付(「#」囲い：ブランクを除く) If Trim(strFld) = "" Then FP_EditCsvFld = "" Else FP_EditCsvFld = g_cnsSH & strFld & g_cnsSH End If Case Else ' 自動判定 ' タイプ判定 Select Case True Case IsDate(vntValue) FP_EditCsvFld = strFld Case IsNumeric(vntValue) FP_EditCsvFld = strFld Case Else ' ブランクセルは終了 If Trim(strFld) = "" Then FP_EditCsvFld = "" Exit Function End If lngPos = 1 ' 1文字ずつ判定 Do While lngPos <= Len(strFld) strChar = Mid(strFld, lngPos, 1) ' 文字判定 Select Case strChar Case strSepChar ' ダブルクォーテーション blnNeedDQ = True ' ダブルクォーテーションは連記 strFldO = strFldO & strChar Case g_cnsComm ' カンマ blnNeedDQ = True Case vbCr, vbLf ' 改行コード blnNewLine = True End Select strFldO = strFldO & strChar ' 次の文字へ lngPos = lngPos + 1 Loop ' セル内改行有無 If blnNewLine Then blnNeedDQ = True ' CrLfを一旦Lfのみに変換 strFldO = Replace(strFldO, vbCrLf, vbLf) ' Crのみを一旦Lfのみに変換 strFldO = Replace(strFldO, vbCr, vbLf) ' LfをCrLfに変換 strFldO = Replace(strFldO, vbLf, vbCrLf) End If ' ダブルクォーテーション囲い要否 If blnNeedDQ Then FP_EditCsvFld = strSepChar & strFldO & strSepChar Else FP_EditCsvFld = strFldO End If End Select End Select End Function '*************************************************************************************************** '* 処理名 ：GP_AppendMessage2 '* 機能 ：エラーメッセージ累積 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 今回メッセージ(String) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2019年12月22日 '* 作成者 ：井上 治 '* 更新日 ：2019年12月22日 '* 更新者 ：井上 治 '* 機能説明：改行を付加して追加 '* 注意事項： '*************************************************************************************************** Private Sub GP_AppendMessage2(ByVal strAddMSG As String) '----------------------------------------------------------------------------------------------- If g_strErrMSG <> "" Then g_strErrMSG = g_strErrMSG & vbCrLf g_strErrMSG = g_strErrMSG & strAddMSG End Sub '*************************************************************************************************** ' ■■■ プロパティ ■■■ '*************************************************************************************************** ' 項目カラム数(Long) '--------------------------------------------------------------------------------------------------- Friend Property Let prpCntColumns(ByVal lngValue As Long) g_lngCntColumns = lngValue End Property '=================================================================================================== ' 読出し先頭行番号(Long) '--------------------------------------------------------------------------------------------------- Friend Property Let prpFirstRow(ByVal lngValue As Long) g_lngFirstRow = lngValue End Property '=================================================================================================== ' 読出し先頭カラム番号(Long) '--------------------------------------------------------------------------------------------------- Friend Property Let prpFirstCol(ByVal lngValue As Long) g_lngFirstCol = lngValue End Property '=================================================================================================== ' 見出し行数(Long) '--------------------------------------------------------------------------------------------------- Friend Property Let prpCntMidashiRow(ByVal lngValue As Long) g_lngCntMidashiRow = lngValue End Property '=================================================================================================== ' 最終行判定列番号(Long) '--------------------------------------------------------------------------------------------------- Friend Property Let prpColCntMaxRows(ByVal lngValue As Long) g_lngColCntMaxRows = lngValue End Property '=================================================================================================== ' 見出し出力方法(Long) '--------------------------------------------------------------------------------------------------- Friend Property Let prpUseMidashi(ByVal lngValue As Long) g_lngUseMidashi = lngValue End Property '=================================================================================================== ' Unicode指定(Boolean) '--------------------------------------------------------------------------------------------------- Friend Property Let prpUseUnicode(ByVal blnValue As Boolean) g_blnUseUnicode = blnValue End Property '=================================================================================================== ' 項目境界文字(String) '--------------------------------------------------------------------------------------------------- Friend Property Let prpSepChar(ByVal strValue As String) g_strSepChar = strValue End Property '=================================================================================================== ' 出力ファイル名(String) '--------------------------------------------------------------------------------------------------- Friend Property Let prpFilename(ByVal strValue As String) g_strFilename = strValue End Property '=================================================================================================== ' カラム単位編集方法(String) '--------------------------------------------------------------------------------------------------- Friend Property Let prpColEdit(ByVal strValue As String) Dim lngPos As Long ' 文字位置INDEX Dim lngPosMax As Long ' 文字位置上限 lngPosMax = Len(strValue) ReDim g_tblColEdit(1 To lngPosMax) ' カラム単位編集方法をテーブル化 For lngPos = 1 To lngPosMax g_tblColEdit(lngPos) = CLng(Mid(strValue, lngPos, 1)) Next lngPos End Property '=================================================================================================== ' エラーメッセージ(String) '--------------------------------------------------------------------------------------------------- Friend Property Get prpErrMSG() As String prpErrMSG = g_strErrMSG End Property '----------------------------------------<< End of Source >>----------------------------------------
←WriteCSVFile5.zip
(65KB)