vbs［003］Excel の QueryTable で CSV ファイルを取り込む VBScript

たとえば、

文書ID,組織コード,保管アドレス
901234567890987654321,0012,3-5
909876543210123456789,0013,3-7

のような CSV ファイルを Excel で直接開くと、

文書ID	組織コード	保管アドレス
9.01235E+20	12	3月5日
9.09877E+20	13	3月7日

のように勝手に変換されて表示されてしまう。かといって、いちいち PowerQuery で開くのも面倒だ。

そこで、Excel の QueryTable で CSV データを文字列として 取り込む VBSript ファイルを作ってみる。

CSVをExcelで開く.vbs

' Excelが余計なことをしないように、CSVデータを文字列として開く
' このスクリプトファイルをSendToフォルダに入れて、
' 選択したCSVファイルを右クリックでこのスクリプトに［送る］か、もしくは、
' 選択したCSVファイルをこのスクリプトファイルに直接ドラッグする
' 複数ファイル選択可（一つのブックに選択ファイル分のシートが作成される）

Option Explicit

Dim args, fso, i, sh, cntAry

Set args = WScript.Arguments    '// 選択したCSVファイルのコレクションオブジェクト

Set fso = CreateObject("Scripting.FileSystemObject")

With CreateObject("Excel.Application")
    .Visible = True

    With .Workbooks.Add
        .Application.WindowState = 3    '// ウィンドウを最大化する

        For i = 0 To args.Count-1
            Set sh = .Worksheets.Add

            cntAry = XlQueryTable(args(i), "Shift-JIS", sh)

            With sh
                .Name = fso.GetFileName(args(i))
                .Range(.Cells(1, 1), .Cells(1, cntAry(1))).Interior.Color = RGB(210, 210, 210)
            End With

            Set sh = Nothing
        Next

        CreateObject("WScript.Shell").AppActivate(.Name)  '// 開いたエクセルを最前面にする
    End With
End With

Set fso = Nothing
Set args = Nothing

'// 文字コードが char_code のCSVファイル（csv_path）を QueryTable で読み込み
'// 行数と列数の値を配列で返す

Function XlQueryTable(Byval csv_path, Byval char_code, work_sheet)

    Dim typeArry()   '// データ型の配列
    Dim i            '// ループカウンタ
    Dim charCodeN    '// 文字コード定数
    Dim qt           '// クエリテーブル
    Dim cntAry       '// 行数はcntAry(0)、列数はcntAry(1)

    cntAry = RowsClmsCount(csv_path)

    ReDim typeArry(cntAry(1))
    For i = 0 To cntAry(1)
        typeArry(i) = 2
    Next

    If char_code = "Shift-JIS" Then charCodeN = 932
    If char_code = "UTF-8" Then charCodeN = 65001

    With work_sheet
        With .QueryTables.Add("TEXT;" & csv_path, .Range("A1"))
            .AdjustColumnWidth = True
            .TextFilePlatform = charCodeN
            .TextFileStartRow = 1
            .TextFileTextQualifier = 1
            .TextFileCommaDelimiter = True
            .TextFileColumnDataTypes = Array(typeArry)
            .Refresh
            .Delete
        End With

        For Each qt In .QueryTables
            qt.Delete
        Next
    End With

    XlQueryTable = cntAry

End Function

'// 読み込んだCSVファイルの行数と列数を配列で返す

Function RowsClmsCount(ByVal csv_path)

    Dim lineAry, cntAry(1)

    With CreateObject("Scripting.FileSystemObject").OpenTextFile(csv_path, 1)
        lineAry = Split(.ReadAll, vbCrLf)
        cntAry(0) = UBound(lineAry)
        cntAry(1) = UBound(Split(lineAry(1), ",")) + 1
        RowsClmsCount = cntAry
        .Close
    End With

End Function