Excel VBA CSV→Excel 変換 部品 (ANSIとUTF-8両方に対応）

ExcelVBA 目次 - ray88’s diary
【参考】【VBA】ファイル形式の変換【UTF-8・Shift-JIS・BOM付き】

■CSVをExcelに変換するまでのステップ
CSVをExcel変換するのはエラー処理するとかなり面倒くさい。
STEP１：UTF-8のファイルについては文字化け防止のためいったんANSI形式に変換する
　　　　※上記変換を行う前に元ファイルのBackUpファイルを取っておく
STEP２：文字型判定、数値型判定、先頭が０か判定（０落ち防止）等のデータチェックを
　　　　行い、適切な形式でExcelに書き込みを行う

■呼び出し元コード

Sub TestConvertCSVToExcel()
    Dim wb As Workbook
    Dim backUpFilePath As String
    Dim csvPath As String
    Dim csvFormat As String
    Dim ExcelPath As String
    
    '変換対象のCSVパス
    csvPath = "C:\テスト\CSVテスト\personal_infomation.csv"
    
    '変換先エクセルのパス
    ExcelPath = "C:\テスト\CSVテスト\test.xlsx"
    Set wb = Workbooks.Open(ExcelPath)
    
    '元CSVのバックアップをとっておく
    backUpFilePath = BackUpFile("same", csvPath)
    
    'CSV→Excelへ変換
    ConvertCSVToExcel csvPath, wb, "Sheet2", "UTF-8"
    
    '変換後Excelファイルを保存して閉じる
    wb.Save
    wb.Close
    Set wb = Nothing
End Sub

■CSV→Excel 変換 部品コード（ANSI形式とUTF-8形式）に対応

'----------------------------------------------------------------------------------
'機能：CSVファイルをExcel形式に変換する
'備考:
    '   数値と文字列が混在するCSVファイルに対応
    '   UTF-8の場合はBOMを削除
    
'引数1：CsvFilePath：変換するCSVファイルのパス
'引数2：Wb　　　　 ：変換先のExcelブック
'引数3：sheetName　：変換先 Excelの転記するシート名
'引数4：charSet　　：CSVファイルの文字コード（ANSIまたはUTF-8）

'------------------------------------------------------------------------------------
Sub ConvertCSVToExcel(CsvFilePath As String, wb As Workbook, sheetName As String, charSet As String)

    Dim csvData As String
    Dim csvLines() As String
    Dim csvFields() As String
    Dim rowNum As Long
    Dim colNum As Long
    Dim csvFileNum As Integer
    Dim csvLine As Variant
    Dim i As Long    
    
    'UTF-8形式の場合はANSI形式に変換してから処理する
    If charSet = "UTF-8" Then
        Call ConvertUTF8ToANSI(CsvFilePath)
    End If
    
    ' CSVファイルを開く
    csvFileNum = FreeFile
    Open CsvFilePath For Binary As #csvFileNum
    csvData = Input(LOF(csvFileNum), csvFileNum)
    Close #csvFileNum
    If Right(csvData, 2) <> vbCrLf Then
        csvData = csvData & vbCrLf
    End If
    
    ' CSVデータを行ごとに分割
    csvLines = Split(csvData, vbCrLf)
    
    ' Excelに転記
    rowNum = 1
    colNum = 1
    wb.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = sheetName
    
        For Each csvLine In csvLines
            ' CSVデータをカンマごとに分割
            csvFields = Split(csvLine, ",")
            For i = LBound(csvFields) To UBound(csvFields)
            
                If Left(csvFields(i), 1) = "0" Then
                    ' 先頭に0が付く場合は文字型で転記
                    Worksheets(sheetName).Cells(rowNum, colNum).Value = "'" & csvFields(i)
                
                ElseIf IsNumeric(csvFields(i)) Then
                    ' 数値の場合は数値型で転記
                    Worksheets(sheetName).Cells(rowNum, colNum).Value = CDbl(csvFields(i))
                Else
                    ' 文字列の場合は文字列型で転記
                        Worksheets(sheetName).Cells(rowNum, colNum).Value = csvFields(i)
                End If
                colNum = colNum + 1
                
            Next i
            ' 次の行に移動
            rowNum = rowNum + 1
            colNum = 1
        Next csvLine    
    
    ' 文字コードがUTF-8の場合はBOMを削除
    If charSet = "UTF-8" Then
        Worksheets(sheetName).Cells.Replace what:=ChrW(65279), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    End If
End Sub

■UTF-８形式のCSVをANSI形式に変換（文字化け防止）

'--------------------------------------------------------
'機能：UTF-8形式のCSVファイルをANSI形式に変換する
'引数1：変換対象のCSVファイルパス
'戻り値：ANSI形式に変換後のCSVファイルパス
'　　　　エラーの場合は「ANSI形式へ変換失敗」を返す
'--------------------------------------------------------
Sub ConvertUTF8ToANSI(CsvFilePath As String)
    '変換したいテキストファイルのファイルパスを作成
    Dim a As String
    Dim i As Long
    Dim b As Variant
        
    'UTF-8もしくはUTF-8（BOM付き）のテキストファイルを読み込み
    With CreateObject("ADODB.Stream")
        .charSet = "UTF-8"
        .Open
        .LoadFromFile CsvFilePath
        a = .ReadText
        .Close
    End With
    
    'UTF-8もしくはUTF-8（BOM付き）以外を読み込んでしまった場合は終了
    For i = 1 To Len(a)
        If Mid(a, i, 1) <> Chr(63) Then
            If Asc(Mid(a, i, 1)) = 63 Then
                Exit Sub
            End If
        End If
    Next
    
    '改行毎にデータを分ける
    b = Split(a, vbLf)
    
    'Shift-JIS形式でテキストファイルへ出力
    Open CsvFilePath For Output As #1
        For i = 0 To UBound(b)
            Print #1, b(i)
        Next
    Close #1          
End Sub

■CSVをUTF-8からANSI形式に変換する際に元ファイルのBackUpを取っておく

Function BackUpFile(ByVal backupPath As String, ByVal originalFilePath As String) As String
'----------------------------------------------------------------------------
'機能：指定したフォルダパスに元ファイルをコピーし、の元のファイル名の頭に
'     「BackUp_」をつけたファイル名で格納する

'引数1   ：BackUp格納先のフォルダパス
'         （元ファイルと同じパスに格納する場合は「same」を指定する）
'引数2   ：元ファイルのパス
'戻り値  ：BackUpファイルのパス
'----------------------------------------------------------------------------
    'フォルダが存在しない場合は、作成する
    If backupPath <> "same" And Dir(backupPath, vbDirectory) = "" Then
        MkDir backupPath
    End If
    
    'バックアップファイルのファイル名を作成する
    Dim backupFileName As String
    backupFileName = "BackUp_" & Dir(originalFilePath)
    
    'バックアップファイルのパスを作成する
    Dim backUpFilePath As String
    If backupPath = "same" Then
        backUpFilePath = Left(originalFilePath, InStrRev(originalFilePath, "\")) & backupFileName
    Else
        backUpFilePath = backupPath & "\" & backupFileName
    End If
    
    '元ファイルをバックアップする
    FileCopy originalFilePath, backUpFilePath
    
    'バックアップファイルのパスを返す
    BackUpFile = backUpFilePath
End Function