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 データを文字列として取り込む VBScript ファイルを作ってみる。

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 = Left(fso.GetFileName(args(i)), 30)  '// 31文字制限
                .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 = LinesCount(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 LinesCount(ByVal csv_path)

    Dim lineAry, cntAry(1)

    With CreateObject("Scripting.FileSystemObject").OpenTextFile(csv_path, 1)
        lineAry = Split(.ReadAll, vbCrLf)
        .Close
    End With

    cntAry(0) = UBound(lineAry)
    cntAry(1) = UBound(Split(lineAry(1), ",")) + 1

    LinesCount = cntAry

End Function

---

＜修正＞
［2022-01-20］
（前）.Name = fso.GetFileName(args(i)
（後）.Name = Left(fso.GetFileName(args(i)), 30) '// 31文字制限