Разбить текстовый табличный файл по признаку на несколько

Dim objFS, objFile, objDict
Dim strPath, arrTemp, strTemp, i
strPath = "d:\book.csv"
Set objFS = CreateObject("Scripting.FileSystemObject")
If objFS.FileExists(strPath) Then
    arrTemp = Split(objFS.OpenTextFile(strPath, 1).ReadAll, vbNewLine)
    Set objDict = CreateObject("Scripting.Dictionary")
    For i = 0 To UBound(arrTemp)
        If Len(arrTemp(i)) > 0 Then
            strTemp = Split(arrTemp(i), ";")(0)
            If objDict.Exists(strTemp) Then
                objDict.Item(strTemp) = objDict.Item(strTemp) & vbNewLine & arrTemp(i)
            Else
                objDict.Add strTemp, arrTemp(i)
            End If
        End If
    Next
    strTemp = vbNullString
    For Each i In objDict.Keys
        Set objFile = objFS.CreateTextFile(Left(strPath, InStrRev(strPath, "\")) & i & ".txt", True)
        objFile.WriteLine objDict.Item(i)
        objFile.Close
        strTemp = strTemp & Left(strPath, InStrRev(strPath, "\")) & i & ".txt" & vbNewLine
    Next
    Set objFile = Nothing
    Set objDict = Nothing
    Erase arrTemp
    If Len(strTemp) > 0 Then
        WScript.Echo "Список результирующих файлов:" & vbNewLine & UCase(strTemp)
    Else
        WScript.Echo "Ни одного результирующего файла не создано."
    End If
Else
    WScript.Echo "Файл не найден."
End If
Set objFS = Nothing
WScript.Quit 0