VBScript- (TIP) Split text files into manageable chunks

[prehistory]

Here's another useful VBScript. I use it to take huge point cloud files and break them up into small sets for use as comparison points or whatever.  This particular one creates 4000-point text files, but you can change that to any number you want.  The output files get named "...split1", "..split2", etc.

Code Select Expand

Const ForReading = 1
Const ForAppending = 2

BreakFile = "D:\Data\piston_face_Files\user-data\xy_grid.txt"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(Breakfile, ForReading)

limit = 4000

FiletoSplit = objFSO.GetFileName(BreakFile)
FolderDest = Mid(objFSO.GetAbsolutePathName(BreakFile),1,Len(objFSO.GetAbsolutePathName(BreakFile))-(Len(FiletoSplit)))
FileSplitName = objFSO.GetBaseName(BreakFile)
dtmStart = Now()

Set objFile = objFSO.OpenTextFile(Breakfile, ForReading)
strContents = objFile.ReadAll
FileNum = 1
fname = FolderDest & FileSplitName & "Split " & FileNum & ".txt"
Set objFile1 = objFSO.OpenTextFile(fname, ForAppending, True)
CountLines = 0
arrLines = Split(strContents, vbCrLf)
HeaderText = arrLines(0)

For i = 0 to ubound(arrlines)
strLine = arrLines(i) & vbCrLf
objFile1.Write strLine
If (Countlines) < limit Then
countlines = countlines + 1
ElseIf Countlines >= limit Then
objFile1.Close
Countlines = 0
FileNum = FileNum + 1
fname = FolderDest & FileSplitName & "Split " & FileNum & ".txt"
Set objFile1 = objFSO.OpenTextFile(fname, ForAppending, True)
objFile1.Write HeaderText & vbCrLf
End If
Next

objFile.Close
dtmEnd = Now()

[prehistory]

Incidentally, if you want to keep your VBScript encapsulated inside a PW macro, make sure to have your macro WRITE then EXECUTE the vbs file.  Here's how:

First, use the macro language to create a text file,

Code Select Expand

DECLARE vbscript  "$_PWK_FILES_PATH/user-data/splitfile.vbs"
DECLARE file "xy_grid.txt"

DATA_FILE CREATE ("$vbscript", "Ascii", "Yes")

then append lines with all the VB commands, like this

Code Select Expand

DATA_FILE APPEND LINES ("$vbscript", {"Const ForReading = 1", "Const ForAppending = 2", "BreakFile = ${_QUOTES}$_PWK_FILES_PATH\user-data\$file${_QUOTES}", "Set objFSO = CreateObject(${_QUOTES}Scripting.FileSystemObject${_QUOTES})", "Set objFile = objFSO.OpenTextFile(Breakfile, ForReading)", "limit = 4000"})
DATA_FILE APPEND LINES ("$vbscript", {"FiletoSplit = objFSO.GetFileName(BreakFile)", "FolderDest = Mid(objFSO.GetAbsolutePathName(BreakFile),1,Len(objFSO.GetAbsolutePathName(BreakFile))-(Len(FiletoSplit)))", "FileSplitName = objFSO.GetBaseName(BreakFile)", "dtmStart = Now()", "Set objFile = objFSO.OpenTextFile(Breakfile, ForReading)", "strContents = objFile.ReadAll"})
DATA_FILE APPEND LINES ("$vbscript", {"FileNum = 1", "fname = FolderDest & FileSplitName & ${_QUOTES}Split_${_QUOTES} & FileNum & ${_QUOTES}.txt${_QUOTES}", "Set objFile1 = objFSO.OpenTextFile(fname, ForAppending, True)", "CountLines = 0", "arrLines = Split(strContents, vbCrLf)", "HeaderText = arrLines(0)"})
DATA_FILE APPEND LINES ("$vbscript", {"For i = 0 to ubound(arrlines)", "strLine = arrLines(i) & vbCrLf", "objFile1.Write strLine", "If (Countlines) < limit Then", "countlines = countlines + 1", "ElseIf Countlines >= limit Then", "objFile1.Close"})
DATA_FILE APPEND LINES ("$vbscript", {"Countlines = 0", "FileNum = FileNum + 1", "fname = FolderDest & FileSplitName & ${_QUOTES}Split_${_QUOTES} & FileNum & ${_QUOTES}.txt${_QUOTES}", "Set objFile1 = objFSO.OpenTextFile(fname, ForAppending, True)", "objFile1.Write HeaderText & vbCrLf", "End If", "Next"})
DATA_FILE APPEND LINES ("$vbscript", {"objFile.Close", "dtmEnd = Now()"})

Finally, use a SYSTEM command to make your computer fire off the macro

Code Select Expand

SYSTEM("${_QUOTES}$vbscript ${_QUOTES}")