【Excel】输出CSV文本

'*******************************************************************************
'   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 = 2
    ' 最終行まで繰り返す
    Do Until GYO > GYOMAX
        ' レコードを出力(REC編集処理より受け取る)
        TS.WriteLine FP_EDIT_CSVREC(GYO, 1, 5)
        ' 行を加算
        GYO = GYO + 1
    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)
    ' ２番目以降のカラムの編集
    For COL = STRCOL + 1 To ENDCOL
        strREC = strREC & "," & FP_EDIT_COLUMN(GYO, COL)
    Next COL
    ' 編集したレコード内容を戻り値にセット
    FP_EDIT_CSVREC = strREC
End Function

'*******************************************************************************
' １カラム分の編集処理
'*******************************************************************************
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 >>-------------------------------