カレントフォルダにあるCSVをExcelシートに読み込む

概要

カレントフォルダに置かれているCSVファイルを、Excelの各シートへ読み込みたい時に書いたマクロ。

背景

予め別のマクロを組み込んであるレポーティング用のExcelファイルに、元になるデータをCSVエクスポートしたCSVを読み込ませたかった。

レポーティング周りは他のBIツールとかを使ったほうがいいよねという話はもちろんあるが、すでにあるExcelマクロの資産を使うべきだと思うということで。

そのため、報告用のシートは残しつつ、データの部分だけCSV_という接頭辞をつけた状態で毎回削除し、読み込めるようにしている。

コード

Option Explicit


Sub readCsvListToWorksheet()
    Dim newSheet As Worksheet
    Dim sheetName As String
    Dim tmpSheet As Worksheet
    Dim textFile As String
    Dim preFix As String
    preFix = "CSV_"
    ' preFix で始まるシートは全消し
    Application.DisplayAlerts = False 'データの入っているシート削除の警告を一時抑止
    For Each tmpSheet In Worksheets
        If Left(tmpSheet.name, Len(preFix)) = preFix Then
            tmpSheet.Delete
        End If
    Next tmpSheet
    Application.DisplayAlerts = True



    ' カレントのCSVファイルを全件読んでいく
    textFile = Dir(ActiveWorkbook.Path & "\*.csv")
    Dim tmp As String
    Do While textFile <> ""
        sheetName = "CSV_" & Left(textFile, 20)

        Set newSheet = ActiveWorkbook.Worksheets.Add
        newSheet.name = sheetName

        tmp = ActiveWorkbook.Path & "\" & textFile
        Call readCsv(newSheet, newSheet.name, "TEXT;" & tmp)


        textFile = Dir()
    Loop
End Sub

Sub readCsv(newSheet As Worksheet, name As String, textFile As String)
    With newSheet.QueryTables.Add( _
        Connection:=textFile, _
        Destination:=Range("$A$1"))
        .name = name
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 932 'SJISの意味
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)    'CSVのフィールドの分を収める長さで定義しないといけないのでここが汎用的ではない
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

End Sub