【VBScript】csv⇒Excelに変換＆セル書式を文字列にする

ExcelでCSVファイルを開くと、例えば

• 頭の0が消えてしまう
• コード値がなぜか日付に変換されてしまう

などの事象が起こります。

回避するためには、

• Excelを開いた後でセルの書式設定を文字列にする
• カンマ区切りでセル分割する

をやれば直るのですが、それが面倒（というか↑ができない）なユーザー向けにスクリプトを書いてみました。
僕自身のVBScriptの学習教材として、良い勉強になりましたので備忘録がてら載せておきます。

※半日くらいで作ったものなのでソースは汚いです。ご了承下さい＞＜

前提

こんなCSVファイルがあるとします。

Excelで開くとテストNo列が日付になってしまっています。

使い方

①csv⇒xlsx変換.vbsにtest.csvをドラッグ＆ドロップ

②こんな感じで進捗度を表示しつつ、CSV⇒EXCEL変換処理を行います

③処理完了後、生成されたExcelファイルを開くと各列が文字列セルに変換されています

ソースコード

csv⇒xlsx変換.vbs

Option Explicit
On Error Resume Next

' 引数より対象ファイル名を取得する
Dim GetPathArray, objFSO, objExcel, ObjIE
Set GetPathArray = WScript.Arguments
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objIE = CreateObject("InternetExplorer.Application")

Dim pt, addCount, totalCount
addCount = 0
totalCount = 0

' Excelプロセス存在確認
If checkExcelProc(1) = False Then
    MsgBox "Excelファイルを閉じてから再度実行してください。処理を終了します。"
    closeObject()

    WScript.Quit
Else
    Set objExcel = CreateObject("Excel.Application")
    objExcel.DisplayAlerts = False
End If

If GetPathArray.Count = 0 Then
    MsgBox "処理対象CSVファイルをドラッグ＆ドロップしてください。処理を終了します。"
    closeObject()
    WScript.Quit
Else
    initIE()
    totalCount = getTotalCount(GetPathArray)
End If


' ファイルごとに行数分ループ開始
For Each pt in GetPathArray
    Dim ext
    ext = objFSO.GetExtensionName(pt)

    If ext = "csv" Then

        Dim ts, rowCount, columnCount
        Set ts = objFSO.OpenTextFile(pt)

        rowCount = 0
        columnCount = 0

        Do While ts.AtEndOfstream <> True
            Dim lineData, spLineData
            lineData = ts.readLine()
            spLineData = Split(lineData, ",")

            ' ヘッダーのカラム数を取得
            If rowCount = 0 Then
                ' 新規Excelファイルを作成
                Dim xlBook
                Set xlBook = objExcel.Workbooks.Add

                xlBook.SaveAs(Replace(pt, ".csv", ".xlsx"))

                columnCount = UBound(spLineData)

                Dim i
                For i = 0 To columnCount
                    ' システム番号列のセル書式を文字列にする
                    xlBook.Worksheets(1).Columns(i + 1).NumberFormatLocal = "@"
                Next

            End If

            ' 記入処理
            If lineData <> "" Then
                Dim k
                For k = 0 To columnCount
                    xlBook.Worksheets(1).Cells(rowCount + 1, k + 1).Value = spLineData(k)
                Next

            Else
                xlBook.Worksheets(1).Cells(rowCount + 1, 1).Value = lineData
            End If

            rowCount = rowCount + 1
            addCount = addCount + 1

            ' 進捗度を進める
            updateMsg "(" & Round((addCount / totalCount) * 100, 0) & "%)"

        Loop

        ' ファイル保存
        xlBook.Save
        xlBook.Close
        Set xlBook = Nothing

        ts.Close
        Set ts = Nothing

    Else
        MsgBox objFSO.GetFileName(pt) & vbCrLf & _
               "csvファイルでないため、処理をスキップします。", vbSystemModal
    End If

    If Err.Number <> 0 Then
        MsgBox "エラーが発生しました。" & vbCrLf & _
                      "ファイル名：" & objFSO.GetFileName(pt) & vbCrLf & _
                      "エラー番号：" & Err.Number & vbCrLf & _
                      "エラー詳細：" & Err.Description
    End If

Next

' オブジェクトクローズ
closeObject()

' Excelプロセス終了
checkExcelProc(2)

Set GetPathArray = Nothing

If Err.Number <> 0 Then
    MsgBox "ロボット処理を終了しました。", vbSystemModal
Else
    MsgBox "変換完了しました。", vbSystemModal
End If



' プログレスバー初期設定
Sub initIE()
    With objIE
        .Navigate("about:blank")
        .Height = 200
        .Width = 300
        .Top = .Document.parentWindow.screen.Height / 2
        .Left = .Document.parentWindow.screen.Width / 2
        .Document.CharSet = "UTF-8"
        .Document.Title = "スクリプト実行中"
        .AddressBar = False
        .StatusBar = False
        .MenuBar = False
        .ToolBar = False
        .Resizable = False
        .Visible = True
    End With
End Sub


' 処理総件数取得
Function getTotalCount(arg)
    Dim tmpPt, tmpCount
    tmpCount = 0

    For Each tmpPt in arg
        Dim cnt, tmpTs, tmpExt
        cnt = 0
        Set tmpTs = objFSO.OpenTextFile(tmpPt)
        tmpExt = objFSO.GetExtensionName(tmpPt)

        If tmpExt = "csv" Then
            Do While tmpTs.AtEndOfstream <> True
                tmpCount = tmpCount + 1
                cnt = cnt + 1
                tmpTs.ReadLine()
            Loop

            tmpTs.Close
            Set tmpTs = Nothing

        End If
    Next

    getTotalCount = tmpCount

End Function


' メッセージ更新
Sub updateMsg(val)
    With objIE
        .Document.Body.innerHTML = val
        .Document.Script.setTimeout "javascript:ScrollTo(0," & .Document.Body.ScrollHeight & ");", 0
    End With
End Sub


' オブジェクトを閉じる
Sub closeObject()
    objIE.Quit
    Set objIE = Nothing

    Set objFSO = Nothing

    objExcel.Quit
    Set objExcel = Nothing

End Sub


' Excelプロセスチェック
' 引数⇒1：Excelプロセス存在確認 2：Excelプロセス終了
Function checkExcelProc(val)
    Dim result, objProcList, objProcess
    result = True
    Set objProcList = GetObject("winmgmts:").InstancesOf("win32_process")

    For Each objProcess In objProcList
        If LCase(objProcess.Name) = "excel.exe" Then
            If val = 1 Then
                result = True
            Else
                objProcess.Terminate
                result = False
            End If
        Else
        End If
    Next

    Set objProcList = Nothing

    checkExcelProc = result

End Function