NDW*

Excel VBAで独自形式のCSVファイルを作成

Excel/Word
目次

概要

  • ExcelはRFC4180に準拠したCSV出力が可能ですが、逆にRFC4180に準拠しない独自形式のCSV出力はできません。
    そのため、ここではExcel VBAを使って独自のCSVファイルを出力するサンプルを紹介します。
  • サンプルの内容を少々変更すれば、タブ区切りファイル(TSV)やSQLインサート文の作成等にも対応できます。このように応用する前提のサンプルであるため、可能な限りシンプルにしています。
  • 動作確認した環境は次の通りです。
    OSWindows 10(64ビット)
    OfficeMicrosoft Office Professional Plus 2019
    (Microsoft® Excel® 2019 MSO (16.0.14228.20216) 32 ビット )

サンプルの紹介

※ここで説明する仕様はサンプル用であり、VBAコードを修正すれば簡単に変更できます。

  • シートに定義した行・列データをCSV形式でファイル(UTF-8)に出力します。（１シート１ファイル）
  • 先頭のサマリシートにある「一括ファイル出力」ボタンを押すことで、各シートからのファイル出力を一括で行えます。
    （先頭が数字３桁で始まるシートが対象となります。）
  • 各シートの「ファイル出力」ボタンを押すことで、シート個別にファイル出力を行えます。
  • ファイルの出力先は、Excelファイルがあるフォルダ直下のoutputフォルダです。
    ファイル名は「シート名＋”.csv”」としています。
  • サンプルでは、カンマ、ダブルクォーテーション、改行等の特殊な文字が含まれていても、そのままファイルに出力しています。要件に応じた内容を出力できるようサンプルを修正してください。

サンプルコード

  • このサンプルでは、UTF8形式でファイル保存するためにADO関連ライブラリを使用しています。
    参照設定で「”Microsoft ActiveX Data Objects X.X Library”」を追加してください。
  • データの読み取りを開始する行・列位置、出力フォルダ等を変更したい場合は「★」印を参考にしてください。
  • サンプルの完全なコード(Excelのxlsmファイル)は、こちらからダウンロードできます。
Option Explicit

'★シートでの読み取り開始列(A始まり)
Const StartCol As String = "B"

'★シートでの読み取り開始行(1始まり)
Const StartRowIndex As Integer = 2

'★列区切りと拡張子
'Const ExtName As String = ".tsv"
'Const Deli As String = vbTab
Const ExtName As String = ".csv"
Const Deli As String = ","

'出力先フォルダ(事前作成が必要)
Const BaseFolder As String = ".\output"

'一部省略......................

'対象シートの領域をファイルに出力
Sub OutputCsvFile(sheetName As String, filename As String)

    Dim ws As Worksheet: Set ws = Worksheets(sheetName)
    Dim i As Integer, j As Integer
    
    'シート上の使用領域の最終行列を取得(見た目と一致しない場合あり)
    Dim maxRowIndex As Integer, maxColIndex As Integer
    maxRowIndex = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).row
    maxColIndex = ws.UsedRange.Columns(ws.UsedRange.Columns.Count).Column

    '開始列・終了列インデックスを決定
    Dim startColIndex As Integer
    startColIndex = Asc(StartCol) - Asc("A") + 1
    Dim endColIndex As Integer: endColIndex = startColIndex
    For i = startColIndex To maxColIndex
        If ws.Cells(StartRowIndex, i).value = "" Then Exit For
        endColIndex = i
    Next

    '各行の列値を抽出してレコードデータを生成
    Dim content As String   '全体データ(ファイル内容)
    Dim record As String    '行データ
    Dim value As String
    content = ""
    For i = StartRowIndex To maxRowIndex
        record = ""
        For j = startColIndex To endColIndex
            
            '★出力値を加工する場合はこの辺を修正してください。
            
            '空行や未使用領域をスキップ
            value = ws.Cells(i, j).value
            If j = 0 And value = "" Then GoTo Skip
            
            '行データに値を追加
            If record <> "" Then record = record & Deli
            record = record & value
        Next
        
        '生成行を追加(最終行に改行を含めない)
        If content <> "" Then content = content & vbCrLf
        content = content & record
Skip:
    Next
    
    '生成したCSVデータをファイルに保存
    SaveAsUtf8 filename, content

End Sub

'コンテンツをUTF-8形式のファイルに上書き保存する。
'(ファイルパス上のフォルダは存在する前提)
Public Sub SaveAsUtf8(filename As String, contents As String)
    
    If contents = "" Then
        MsgBox "空ファイルの出力はスキップ: " & filename
        Exit Sub
    End If
    
    '次の参照設定が必要
    '"Microsoft ActiveX Data Objects 6.1 Library"
    Dim oStream As New ADODB.Stream
    
    With oStream
    
        'ファイルオープン
        .Charset = "UTF-8"
        .LineSeparator = adCRLF
        .Type = adTypeText
        .Open
    
        'データを出力
        .WriteText contents
    
        'ストリームをバイト列としてbufに退避
        Dim buf() As Byte
        .Position = 0
        .Type = adTypeBinary
        .Position = 3 'BOM(3バイト)を読み飛ばし(空ファイルは想定外)
        buf = .Read
        .Close
    
        'バイト列をファイルに出力
        .Open
        .Position = 0
        .Type = adTypeBinary
        .Write buf
        .SaveToFile filename, adSaveCreateOverWrite
        
        .Close
    End With
    
    Set oStream = Nothing
End Sub