'***************************************************************************************************
' CSV形式テキストファイル書き出しサンプル Module1(Module)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'03/07/25(1.00)新規作成
'03/12/04(1.01)初回修正
'20/02/26(1.10)*.xlsm化、他
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsTitle As String = "CSVテキストファイル出力処理"
Private Const g_cnsFilter As String = "CSVファイル (*.csv;*.dat),*.csv;*.dat"
'***************************************************************************************************
' ■■■ ワークシート側からの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名 :WRITE_CSVFile1
'* 機能 :CSV形式テキストファイル書き出しサンプル
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月25日
'* 作成者 :井上 治
'* 更新日 :2020年02月26日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:サンプルなのでエラー処理は行なっていません
'***************************************************************************************************
Sub WRITE_CSVFile1()
'-----------------------------------------------------------------------------------------------
Dim intFF As Integer ' FreeFile値
Dim lngRow As Long ' 収容するセルの行
Dim lngRowMax As Long ' データが収容された最終行
Dim lngRec As Long ' レコード件数カウンタ
Dim lngCol As Long ' カラム(Work)
Dim strFileName As String ' OPENするファイル名(フルパス)
Dim vntFileName As Variant ' ファイル名受取り用
Dim tblFld(1 To 5) As Variant ' 書き出すレコード内容
'-----------------------------------------------------------------
' ①「名前を付けて保存」のフォームでファイル名の指定を受ける
Application.StatusBar = "出力するファイル名を指定して下さい。"
vntFileName = Application.GetSaveAsFilename(InitialFilename:="SAMPLE.csv", _
FileFilter:=g_cnsFilter, _
Title:=g_cnsTitle)
' キャンセルされた場合はFalseが返るので以降の処理は行なわない
If VarType(vntFileName) = vbBoolean Then Exit Sub
strFileName = vntFileName
'-----------------------------------------------------------------
' ②収容最終行の判定(Excel認知の最終行から上に向かってデータがある行を探す)
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData ' オートフィルタ解除
lngRowMax = Range("$A$" & Rows.Count).End(xlUp).Row
' データ未登録は終了
If lngRowMax < 2 Then
Application.StatusBar = False
MsgBox "テキストをA列2行目から入力してから起動して下さい。", vbExclamation, g_cnsTitle
Exit Sub
End If
' FreeFile値の取得(以降この値で入出力する)
intFF = FreeFile
' 指定ファイルをOPEN(出力モード)
Open strFileName For Output As #intFF
' 2行目から開始
lngRow = 2
'-----------------------------------------------------------------
' ③最終行まで繰り返す
Do While lngRow <= lngRowMax
' レコード件数カウンタの加算
lngRec = lngRec + 1
Application.StatusBar = "出力中です....(" & lngRec & "レコード目)"
Erase tblFld ' 初期化
' A~E列内容をレコードにセット
For lngCol = 1 To 5
tblFld(lngCol) = Cells(lngRow, lngCol).Value
Next lngCol
' レコードを出力
Write #intFF, tblFld(1), tblFld(2), tblFld(3), tblFld(4), tblFld(5)
' 行を加算
lngRow = lngRow + 1
Loop
'-----------------------------------------------------------------
' ④指定ファイルをCLOSE
Close #intFF
Application.StatusBar = False
' 終了の表示
MsgBox "ファイル出力が完了しました。" & vbCr & _
"レコード件数=" & lngRec & "件", vbInformation, g_cnsTitle
End Sub
'----------------------------------------<< End of Source >>----------------------------------------
№ | 処理工程概要 |
---|---|
① |
出力するファイル名の受け取り部分です。前頁の前半部分と同じです。 |
② |
[前処理]として、指定のテキストファイルを開く処理です。前頁の前半部分と同じです。 |
③ |
[主処理]として、ワークシート上の最終行まで出力するループです。 ループ内ではワークシート上の行を加算しながら、「Writeステートメント」で1行分(5列分)を書き出しています。 |
④ |
[後処理]として、ファイルをCLOSEして、
終了メッセージを表示しています。前頁の前半部分と同じです。 |
'***************************************************************************************************
' CSV形式テキストファイル書き出しサンプル(FSO) Module2(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化、他
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsTitle As String = "CSVテキストファイル出力処理"
Private Const g_cnsFilter As String = "CSVファイル (*.csv;*.dat),*.csv;*.dat"
'***************************************************************************************************
' ■■■ ワークシート側からの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名 :WRITE_CSVFile2
'* 機能 :CSV形式テキストファイル書き出しサンプル(FSO)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月25日
'* 作成者 :井上 治
'* 更新日 :2020年02月26日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:サンプルなのでエラー処理は行なっていません
'***************************************************************************************************
Sub WRITE_CSVFile2()
'-----------------------------------------------------------------------------------------------
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するファイル名(フルパス)
Dim vntFileName As Variant ' ファイル名受取り用
'-----------------------------------------------------------------
' ①「名前を付けて保存」のフォームでファイル名の指定を受ける
Application.StatusBar = "出力するファイル名を指定して下さい。"
vntFileName = Application.GetSaveAsFilename(InitialFilename:="SAMPLE.csv", _
FileFilter:=g_cnsFilter, _
Title:=g_cnsTitle)
' キャンセルされた場合はFalseが返るので以降の処理は行なわない
If VarType(vntFileName) = vbBoolean Then Exit Sub
strFileName = vntFileName
'-----------------------------------------------------------------
' ②収容最終行の判定(Excel認知の最終行から上に向かってデータがある行を探す)
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData ' オートフィルタ解除
lngRowMax = Range("$A$" & Rows.Count).End(xlUp).Row
' データ未登録は終了
If lngRowMax < 2 Then
Application.StatusBar = False
MsgBox "テキストをA列2行目から入力してから起動して下さい。", vbExclamation, g_cnsTitle
Exit Sub
End If
Set objFso = New FileSystemObject
' 指定ファイルをOPEN(出力モード)
Set objTs = objFso.CreateTextFile(Filename:=strFileName, Overwrite:=False)
Set objFso = Nothing
' 2行目から開始
lngRow = 2
'-----------------------------------------------------------------
' ③最終行まで繰り返す
Do While lngRow <= lngRowMax
' レコード件数カウンタの加算
lngRec = lngRec + 1
Application.StatusBar = "出力中です....(" & lngRec & "レコード目)"
' レコードを出力(レコード編集処理より受け取る)
objTs.WriteLine FP_EditCsvRec(lngRow, 1, 5)
' 行を加算
lngRow = lngRow + 1
Loop
'-----------------------------------------------------------------
' ④指定ファイルをCLOSE
objTs.Close
Set objTs = Nothing
Application.StatusBar = False
' 終了の表示
MsgBox "ファイル出力が完了しました。" & vbCr & _
"レコード件数=" & lngRec & "件", vbInformation, g_cnsTitle
End Sub
'***************************************************************************************************
' ■■■ サブ処理(Private) ■■■
'***************************************************************************************************
'* 処理名 :FP_EditCsvRec
'* 機能 :CSV形式テキストの1レコードの編集
'---------------------------------------------------------------------------------------------------
'* 返り値 :1レコード分の文字列(String)
'* 引数 :Arg1 = シート上の行(Long)
'* Arg2 = シート上の開始列(Long)
'* Arg3 = シート上の終了列(Long)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月25日
'* 作成者 :井上 治
'* 更新日 :2020年02月26日
'* 更新者 :井上 治
'* 機能説明:カンマ区切りでCSV形式レコードを編集
'* 注意事項:
'***************************************************************************************************
Private Function FP_EditCsvRec(ByVal lngRow As Long, _
ByVal lngColS As Long, _
ByVal lngColE As Long) As String
'-----------------------------------------------------------------------------------------------
Dim strRec As String ' レコード編集WORK
Dim lngCol As Long ' 列
' 先頭カラムの編集
strRec = FP_EditField(lngRow, lngColS)
' 2番目以降のカラムの編集
For lngCol = lngColS + 1 To lngColE
strRec = strRec & "," & FP_EditField(lngRow, lngCol)
Next lngCol
' 編集したレコード内容を戻り値にセット
FP_EditCsvRec = strRec
End Function
'***************************************************************************************************
'* 処理名 :FP_EditField
'* 機能 :1項目の編集
'---------------------------------------------------------------------------------------------------
'* 返り値 :1項目分の文字列(String)
'* 引数 :Arg1 = シート上の行(Long)
'* Arg2 = シート上の列(Long)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月25日
'* 作成者 :井上 治
'* 更新日 :2020年02月26日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Function FP_EditField(ByVal lngRow As Long, ByVal lngCol As Long) As String
'-----------------------------------------------------------------------------------------------
Dim strText As String ' テキストWORK
strText = Trim(Cells(lngRow, lngCol).Value)
' 項目種別判定
If IsDate(strText) Then
FP_EditField = Format(CDate(strText), "yyyy/MM/dd") ' 日付
ElseIf IsNumeric(strText) Then
FP_EditField = CStr(CDbl(strText)) ' 数値
ElseIf strText = "" Then
FP_EditField = strText
Else
FP_EditField = """" & Replace(strText, """", """""") & """" ' その他(文字列)
End If
End Function
'----------------------------------------<< End of Source >>----------------------------------------
№ | 処理工程概要 |
---|---|
① |
出力するファイル名の受け取り部分です。前頁の後半部分と同じです。 |
② |
[前処理]として、指定のテキストファイルを開く処理です。前頁の後半部分と同じです。 |
③ |
[主処理]として、ワークシート上の最終行まで出力するループです。 ループ内ではワークシート上の行を加算しながら、「WriteLineメソッド」で1行分(5列分)を書き出しています。 1行分のCSV形式テキストの編集を「FP_EditCsvRec」及びその項目編集を「FP_EditField」が行なっています。 |
④ |
[後処理]として、ファイルをCLOSEして、
終了メッセージを表示しています。前頁の後半部分と同じです。 |