【VBA】CSVを出力する

こんにちは。
本日は、VBAで対象のシートの内容を
CSVで出力するサンプルです。

概要

出力対象となるシートを「出力用シート」とします。
釦などを作成し、選択した拡張子で出力します。
行毎に改行し、列毎にカンマで区切って表示します。

サンプル

Option Explicit

Private Const SheetName = "出力用シート"
Private Const StartRow = 1
Private Const StartCol = 1
Private Const MaxRow = 500
Private Const MaxCol = 10
Private Path As String

' --------------------------------------------
' CSV形式で出力します。
' --------------------------------------------
Public Sub CsvMain()

    ' 出力先はこのブックと同じ場所とする
    Path = ThisWorkbook.Path
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(SheetName)

    ' FileSystemObject をセット
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim csvText As String: csvText = ""
    Dim rowIdx As Integer: rowIdx = StartRow
    
    Do While ws.Cells(rowIdx, StartCol).Value <> ""
        
        If rowIdx > MaxRow Then
            Exit Do
        End If
        
        ' 列の内容を取得する
        Dim colIdx As Integer: colIdx = StartCol
        Dim line As String: line = ""
        Do While ws.Cells(rowIdx, colIdx).Value <> ""
        
            If colIdx > MaxCol Then
                Exit Do
            End If
            
            If line = "" Then
                line = ws.Cells(rowIdx, colIdx).Value
            Else
                line = line & "," & ws.Cells(rowIdx, colIdx).Value
            End If
            
            colIdx = colIdx + 1
        Loop
        
        ' 列の内容を行ごとに結果に追加する
        If csvText = "" Then
            csvText = line
        Else
                csvText = csvText & vbCrLf & line
        End If
        
        rowIdx = rowIdx + 1
    Loop
    
    ' ファイル名を取得
    Dim name As String: name = GetFilePath()
    
    ' 書き込み処理
    Dim ts As Object
    Set ts = fso.OpenTextFile(name, 2, True, -2)
    ts.Write (csvText)
    ts.Close
    
    Set ts = Nothing
    Set fso = Nothing
End Sub

' --------------------------------------------
' ファイル名を取得します。
' --------------------------------------------
Private Function GetFilePath() As String

    ' タイトルは「日付_ファイル種別」とする
    Dim title As String: title = Format(Date, "yyyymmdd")
    Dim name As String: name = title & ".csv"
    
    ' ファイルの存在チェック
    Dim count As Integer: count = 1
    Dim file As String: file = Dir(Path & "\" & name)
    Do While file <> ""
        name = title & "_" & count & ".csv"
        file = Dir(Path & "\" & name)
        count = count + 1
    Loop

    GetFilePath = Path & "\" & name
    
End Function

OpenTextFileの引数の内容は以下です。

• 第1引数：ファイルパス
• 第2引数：ファイルの読み込む・書き込みについて(省略可)
  • 1 ：読み取り専用
  • 2 ：上書き
  • 8 ：追記
• 第3引数：存在しない場合に新規作成するかどうか(省略可)
  • True ：作成する
  • False：作成しない
• 第4引数：ファイルのオープン形式(省略可)
  • -2：システムの規定の設定で開く
  • -1：Unicode 形式でファイルを開く
  • 0 ：Ascii 形式でファイルを開く

使用する場面に応じて設定したらいいかと思います。

まとめ

今回はCSVでの出力でしたが、TSVなど
区切り文字や拡張子を調整することで
他のファイルの出力にも対応できるかと思います。
以上です。