
'*******************************************************************************
' CSV形式テキストファイル書き出すサンプル(FSO)
'
' 作成者:井上治 URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'*******************************************************************************
' [参照設定]
' ・Microsoft Scripting Runtime
'*******************************************************************************
Option Explicit '*******************************************************************************
' CSV形式テキストファイル書き出すサンプル③(FSO)
' 参照設定:Microsoft Scripting Runtime
'*******************************************************************************
Sub WRITE_CSVFile3()
Const cnsFILENAME = "\SAMPLE.csv"
Dim FSO As New FileSystemObject ' FileSystemObject
Dim TS As TextStream ' TextStream
Dim GYO As Long ' 収容するセルの行
Dim GYOMAX As Long ' データが収容された最終行 ' 最終行の取得
With ActiveSheet
If .FilterMode Then .ShowAllData
End With
GYOMAX = Range("A65536").End(xlUp).Row
' 指定ファイルをOPEN(出力モード)
Set TS = FSO.CreateTextFile(Filename:=ThisWorkbook.Path & cnsFILENAME, _
Overwrite:=True)
' 2行目から開始
GYO =
' 最終行まで繰り返す
Do Until GYO > GYOMAX
' レコードを出力(REC編集処理より受け取る)
TS.WriteLine FP_EDIT_CSVREC(GYO, , )
' 行を加算
GYO = GYO +
Loop
' 指定ファイルをCLOSE
TS.Close
Set TS = Nothing
Set FSO = Nothing
End Sub '*******************************************************************************
' CSV形式テキストの1レコードの編集処理
'*******************************************************************************
Private Function FP_EDIT_CSVREC(GYO As Long, _
STRCOL As Long, _
ENDCOL As Long) As String
Dim strREC As String
Dim COL As Long ' 先頭カラムの編集
strREC = FP_EDIT_COLUMN(GYO, STRCOL)
' 2番目以降のカラムの編集
For COL = STRCOL + To ENDCOL
strREC = strREC & "," & FP_EDIT_COLUMN(GYO, COL)
Next COL
' 編集したレコード内容を戻り値にセット
FP_EDIT_CSVREC = strREC
End Function '*******************************************************************************
' 1カラム分の編集処理
'*******************************************************************************
Private Function FP_EDIT_COLUMN(GYO As Long, COL As Long) As String
Dim strTEXT As String strTEXT = Trim(Cells(GYO, COL).Value)
If IsDate(strTEXT) Then
FP_EDIT_COLUMN = "#" & strTEXT & "#" ' 日付
ElseIf IsNumeric(strTEXT) = True Then
FP_EDIT_COLUMN = CStr(CDbl(strTEXT)) ' 数値
Else
FP_EDIT_COLUMN = """" & strTEXT & """" ' その他(文字列)
End If
End Function '-----------------------------<< End of Source >>-------------------------------