【VBA】CSVUtil

★プログラミング ・VBA-Util 
Option Explicit

'v1
'****************************************************
'CSV操作クラス
'----------------------------------------------------
'CSVUtil
'****************************************************
'ReadCsv           -CSV読み込み(フルパスorファイル名から) ※拡張子なくても可
'ReadCsvByDialog   -CSV読み込み(ダイアログから)
'WriteCsv          -CSV書き込み(フルパスorファイル名から) ※拡張子なくても可
'WriteCsvByDialog  -CSV書き込み(ダイアログから)
'****************************************************

'プロパティ
Public 文字コード As enm_文字コード
Public 区切り文字 As enm_区切り文字
Public 引用符 As enm_引用符
Public ヘッダー As Boolean
Public 列幅調整 As Boolean

'内部用
Private p_カンマ区切り As Boolean
Private p_タブ区切り As Boolean
Private p_セミコロン区切り As Boolean
Private p_スペース区切り As Boolean
Private p_区切り文字 As Variant

'選択肢
Public Enum enm_文字コード
    UTF8 = 65001
    SJIS = 932
End Enum

Public Enum enm_区切り文字
    カンマ区切り = 1
    タブ区切り = 2
    セミコロン区切り = 3
    スペース区切り = 4
End Enum

Public Enum enm_引用符
    ダブルクォーテーション = 1
    シングルクォーテーション = 2
    なし = -4142
End Enum

'----------------------------------------------------
'◆コンストラクタ
'----------------------------------------------------
Private Sub Class_Initialize()
    文字コード = UTF8
    区切り文字 = カンマ区切り
    引用符 = ダブルクォーテーション
    ヘッダー = True
    列幅調整 = False
End Sub

'----------------------------------------------------
'■CSV読み込み(フルパスorファイル名から) ※拡張子必要
'----------------------------------------------------
'引数1:開くファイルのフルパスまたはファイル名(拡張子必要)
'引数2:CSVの貼り付け先
'----------------------------------------------------
'戻り値:実行結果　※エラーがなければTrue
'----------------------------------------------------
Public Function ReadCsv(ByVal aFullPath As String, aRange As Range) As Boolean
On Error GoTo Err
    '拡張子がついていない場合拡張子(csv)をつける
    If InStr(aFullPath, ".") = 0 Then aFullPath = aFullPath & ".csv"
    'フルパスでない場合、カレントディレクトリ＋ファイル名でフルパスにする
    If InStr(aFullPath, "\") = 0 Then aFullPath = CurDir & "\" & aFullPath
    '文字列で取り込む
    Dim v(255) As Long
    Dim i As Long
    For i = 0 To 255
        v(i) = 2  'xlTextFormat
    Next
    '区切り文字を確定
    ConfirmDelimiter
    'CSVを開く
    Dim qt As QueryTable
    Set qt = aRange.Parent.QueryTables.Add(Connection:="TEXT;" & aFullPath, destination:=aRange)
    With qt
        .TextFilePlatform = 文字コード                    '文字コードを指定
        .TextFileCommaDelimiter = p_カンマ区切り          'カンマ区切り
        .TextFileTabDelimiter = p_タブ区切り              'タブ区切り
        .TextFileSemicolonDelimiter = p_セミコロン区切り  'セミコロン区切り
        .TextFileSpaceDelimiter = p_スペース区切り        'スペース区切り
        .TextFileTextQualifier = 引用符                   '引用符の指定
        .TextFileStartRow = IIf(ヘッダー, 1, 2)           'ヘッダー
        .AdjustColumnWidth = 列幅調整                     '列幅を調整
        .TextFileColumnDataTypes = Array(v)               '文字列で出力
        .RefreshStyle = xlOverwriteCells                  'セルに上書き
        .Refresh                                          'データを表示
        .Delete                                           'CSVとの接続を解除
    End With

    ReadCsv = True
    If logging Then AddLog "ReadCsv", "INFO ", "対象:" & aFullPath
    Exit Function
Err:
    If logging Then AddLog "ReadCsv", "ERROR", "対象:" & aFullPath & " / エラー内容:" & Err.Description
End Function

'----------------------------------------------------
'■CSV読み込み(ダイアログから)
'----------------------------------------------------
'引数1:開くファイルのフルパスまたはファイル名(拡張子必要)
'引数2:CSVの貼り付け先
'----------------------------------------------------
'戻り値:実行結果　※エラーがなければTrue
'----------------------------------------------------
Public Function ReadCsvByDialog(aRange As Range) As Boolean
On Error GoTo Err
    'ダイアログから選択
    Dim fullPath As String: fullPath = Application.GetOpenFilename("CSV,*.csv")
    '選択しなければ終わる
    If fullPath = "False" Then GoTo Err
    
    '文字列で取り込む
    Dim v(255) As Long
    Dim i As Long
    For i = 0 To 255
        v(i) = 2  'xlTextFormat
    Next
    '区切り文字を確定
    ConfirmDelimiter
    'CSVを開く
    Dim qt As QueryTable
    Set qt = aRange.Parent.QueryTables.Add(Connection:="TEXT;" & fullPath, destination:=aRange)
    With qt
        .TextFilePlatform = 文字コード                    '文字コードを指定
        .TextFileCommaDelimiter = p_カンマ区切り          'カンマ区切り
        .TextFileTabDelimiter = p_タブ区切り              'タブ区切り
        .TextFileSemicolonDelimiter = p_セミコロン区切り  'セミコロン区切り
        .TextFileSpaceDelimiter = p_スペース区切り        'スペース区切り
        .TextFileTextQualifier = 引用符                   '引用符の指定
        .TextFileStartRow = IIf(ヘッダー, 1, 2)           'ヘッダー
        .AdjustColumnWidth = 列幅調整                     '列幅を調整
        .TextFileColumnDataTypes = Array(v)               '文字列で出力
        .RefreshStyle = xlOverwriteCells                  'セルに上書き
        .Refresh                                          'データを表示
        .Delete                                           'CSVとの接続を解除
    End With

    ReadCsvByDialog = True
    If logging Then AddLog "ReadCsvByDialog", "INFO ", "対象:" & fullPath
    Exit Function
Err:
    If logging Then AddLog "ReadCsvByDialog", "ERROR", "対象:" & fullPath & " / エラー内容:" & Err.Description
End Function

'----------------------------------------------------
'■CSV書き込み(フルパスorファイル名から)
'----------------------------------------------------
'引数1:保存先フルパスまたはファイル名(拡張子なくても可)
'引数2:書き込み対象(レンジ)
'----------------------------------------------------
'戻り値:実行結果　※エラーがなければTrue
'----------------------------------------------------
Public Function WriteCsv(ByVal aFullPath As String, ByVal aRange As Range) As Boolean
On Error GoTo Err
    Dim csv As String  ' CSV に書き込む全データ
    Dim line As String ' 1 行分のデータ
    Dim row As Range
    Dim col As Range
    Dim item As String
    Dim charset As String
    
'【1.CSVの作成】
    '拡張子がついていない場合、拡張子(csv)をつける
    If InStr(aFullPath, ".") = 0 Then aFullPath = aFullPath & ".csv"
    'フルパスでない場合、カレントディレクトリ＋ファイル名でフルパスにする
    If InStr(aFullPath, "\") = 0 Then aFullPath = CurDir & "\" & aFullPath
    'ヘッダーなしなら削る
    If ヘッダー = False Then
        Set aRange = aRange.Offset(1, 0)                           ' 範囲を 1 行下にずらす
        Set aRange = aRange.Resize(RowSize:=aRange.Rows.Count - 1) ' 範囲を 1 行分縮める
    End If
    '区切り文字の確定
    ConfirmDelimiter
    '区切り文字をつける
    For Each row In aRange.Rows '行のループ
        line = ""
        For Each col In row.Columns '列のループ
            Select Case 引用符
                Case 1: item = """" & col.Value & """"  'ダブルクォーテーション
                Case 2: item = "'" & col.Value & "'"    'シングルクォーテーション
                Case -4142: item = col.Value            'なし
            End Select
            If line = "" Then
                line = item
            Else
                line = line & p_区切り文字 & item
            End If
        Next
        '行を結合
        If csv = "" Then
            csv = line
        Else
            csv = csv & vbCrLf & line
        End If
    Next
    
'【2.CSVの出力(FileUtil.WriteFileを使用)】
    Select Case 文字コード
        Case 65001: charset = "UTF-8"
        Case 932: charset = "SJIS"
    End Select
    'ファイル出力呼び出し
    If Not WriteText(aFullPath, csv, charset) Then GoTo Err
    
    WriteCsv = True
    If logging Then AddLog "WriteCsv", "INFO ", "対象:" & aFullPath
    Exit Function
Err:
    If logging Then AddLog "WriteCsv", "ERROR", "対象:" & aFullPath & " / エラー内容:" & Err.Description
End Function

'----------------------------------------------------
'■CSV書き込み(ダイアログから)
'----------------------------------------------------
'引数1:保存先フルパスまたはファイル名(拡張子なくても可)
'引数2:書き込み対象(レンジ)
'----------------------------------------------------
'戻り値:実行結果　※エラーがなければTrue
'----------------------------------------------------
Public Function WriteCsvByDialog(ByVal aRange As Range) As Boolean
On Error GoTo Err
    Dim fullPath As String
    Dim csv As String  ' CSV に書き込む全データ
    Dim line As String ' 1 行分のデータ
    Dim row As Range
    Dim col As Range
    Dim item As String
    Dim charset As String
    
    'ダイアログから選択
    fullPath = Application.GetSaveAsFilename(FileFilter:="csv,*.csv")
    '選択しなければ終わる
    If fullPath = "False" Then GoTo Err

'【1.CSVの作成】
    'ヘッダーなしなら削る
    If ヘッダー = False Then
        Set aRange = aRange.Offset(1, 0)                           ' 範囲を 1 行下にずらす
        Set aRange = aRange.Resize(RowSize:=aRange.Rows.Count - 1) ' 範囲を 1 行分縮める
    End If
    '区切り文字の確定
    ConfirmDelimiter
    '区切り文字をつける
    For Each row In aRange.Rows '行のループ
        line = ""
        For Each col In row.Columns '列のループ
            Select Case 引用符
                Case 1: item = """" & col.Value & """"  'ダブルクォーテーション
                Case 2: item = "'" & col.Value & "'"    'シングルクォーテーション
                Case -4142: item = col.Value            'なし
            End Select
            If line = "" Then
                line = item
            Else
                line = line & p_区切り文字 & item
            End If
        Next
        '行を結合
        If csv = "" Then
            csv = line
        Else
            csv = csv & vbCrLf & line
        End If
    Next
    
'【2.CSVの出力(FileUtil.WriteFileを使用)】
    Select Case 文字コード
        Case 65001: charset = "UTF-8"
        Case 932: charset = "SJIS"
    End Select
    'ファイル出力呼び出し
    If Not WriteText(fullPath, csv, charset) Then GoTo Err
    
    WriteCsvByDialog = True
    If logging Then AddLog "WriteCsvByDialog", "INFO ", "対象:" & fullPath
    Exit Function
Err:
    If logging Then AddLog "WriteCsvByDialog", "ERROR", "対象:" & fullPath & " / エラー内容:" & Err.Description
End Function

'----------------------------------------------------
'□区切り文字を確定
'----------------------------------------------------
Private Function ConfirmDelimiter()
    p_カンマ区切り = False
    p_タブ区切り = False
    p_セミコロン区切り = False
    p_スペース区切り = False
    
    Select Case 区切り文字
        Case 1: p_カンマ区切り = True: p_区切り文字 = ","
        Case 2: p_タブ区切り = True: p_区切り文字 = vbTab
        Case 3: p_セミコロン区切り = True: p_区切り文字 = ";"
        Case 4: p_スペース区切り = True: p_区切り文字 = " "
    End Select
End Function