2020/10/20 VBA

VBA CSVを読み込む、書き込む

CSVを読み込む

Dim file As Variant
Dim buf As String
Dim row As Variant

file = Application.GetOpenFilename("CSVファイル(*.csv),*.csv")
    
If VarType(file) = vbBoolean Then
    Exit Sub
End If

Open file For Input As #1
    Do Until EOF(1)
        Line Input #1, buf
        row = Split(Replace(buf, """", ""), ",")
    Loop
Close #1

CSVの行数、列数を取得する

Private Function GetCsvSize(filepath As String) As Variant
    Dim fso As Object
    Dim rowCount As Integer
    Dim columnCount As Integer
    Dim row As Variant
    Dim buf As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set txtfile = fso.OpenTextFile(filepath)
    
    Do While txtfile.AtEndOfStream <> True
        buf = txtfile.ReadLine
        row = Split(buf, ",")
        If (columnCount < UBound(row)) Then
            columnCount = UBound(row)
        End If
        
        rowCount = rowCount + 1
    Loop
    Call txtfile.Close
    GetCsvSize = Array(rowCount - 1, columnCount)
End Function

UTF-8のCSVを読み込む

参照設定を追加:Microsoft ActiveX Data Objects 2.8 Library

Private Function ReadCsv(filepath As String) As Variant
    Dim csvSize As Variant
    csvSize = GetCsvSize(filepath)
    
    Dim table
    ReDim table(csvSize(0), csvSize(1)) As String
    Dim i As Integer
    Dim j As Integer
    
    Dim ado As Object
    Set ado = CreateObject("ADODB.Stream")
    
    With ado
        .Charset = "UTF-8"
        .Open
        .LoadFromFile (filepath)
        For i = 0 To csvSize(0)
            buf = .ReadText(adReadLine)
            row = Split(Replace(buf, """", ""), ",")
            For j = 0 To UBound(row)
                table(i, j) = row(j)
            Next
        Next
        .Close
    End With
    
    ReadCsv = table
End Function

UTF-8のCSVを書き込む

参照設定を追加:Microsoft ActiveX Data Objects 2.8 Library

Private Sub WriteCsv(filepath As String, table As Variant)
    Dim ado As Object
    Set ado = CreateObject("ADODB.Stream")
    Dim buf As String
    
    With ado
        .Charset = "UTF-8"
        .Open
        For i = 0 To UBound(table, 1)
            buf = ""
            For j = 0 To UBound(table, 2)
                buf = buf & """" & table(i, j) & """"
                If j <> UBound(table, 2) Then
                    buf = buf & ","
                End If
            Next
            .WriteText buf, adWriteLine
        Next
        .SaveToFile filepath, adSaveCreateOverWrite
        .Close
    End With
End Sub