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

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

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

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

回避するためには、

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

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

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

##前提
こんなCSVファイルがあるとします。
![image.png](https://qiita-image-store.s3.amazonaws.com/0/186221/7b12ef18-37e2-5971-7a42-05050901eb19.png)


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

![image.png](https://qiita-image-store.s3.amazonaws.com/0/186221/a4a54bf0-4ee3-8e59-77ae-21fe76d56826.png)


##使い方
①csv⇒xlsx変換.vbsにtest.csvをドラッグ＆ドロップ
![image.png](https://qiita-image-store.s3.amazonaws.com/0/186221/3cbfaac5-9b47-63c6-80bf-852905612950.png)

②こんな感じで進捗度を表示しつつ、CSV⇒EXCEL変換処理を行います
![image.png](https://qiita-image-store.s3.amazonaws.com/0/186221/9df3e2ee-75f3-2d37-d86c-227b05e14049.png)

③処理完了後、生成されたExcelファイルを開くと各列が文字列セルに変換されています
![image.png](https://qiita-image-store.s3.amazonaws.com/0/186221/352ad481-1da7-bc8e-acb1-afc4b9fc8182.png)


##ソースコード

```vb: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

```