VBScript to split a text file evenly in three

[Kazz013]

Hi,

I am trying to split a text file, which contains a list of servers alphabetically, into three. So far, thanks to "Pegasus [MVP]" I have the following and still stuck here. i think i am approaching this from the wrong angle, any thoughts?

My task is as follows:
Servers.txt file to split evenly into three text files, retaining the alphabetical order of the servers.

sFolder = "c:\dev1"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sFolder)
If oFSO.FolderExists(sFolder & "\Temp") _
Then oFSO.DeleteFolder sFolder & "\Temp"
oFSO.CreateFolder(oFolder.Path & "\Temp")


For Each oFile In oFolder.Files
sName1 = oFile.ParentFolder & "\Temp\" & oFile.Name
sName2 = oFile.ParentFolder & "\Temp\" _
& Left(oFile.Name, Len(oFile.Name) - 5) & "2.txt"
Set oTextFile = oFSO.OpenTextFile(oFile, 1)
Set oOut1 = oFSO.CreateTextFile(sName1)
Set oOut2 = oFSO.CreateTextFile(sName2)
sText = oTextFile.Readall
aText = Split(sText, VbCrLf)
For i = 0 To UBound(aText) \ 3
oOut1.WriteLine aText(i)
Next
For i = UBound(aText) \ 3 + 1 To UBound(aText)
oOut2.WriteLine aText(i)
Next
oTextFile.Close
oOut1.Close
oOut2.Close
Next

For Each oFile In oFolder.Files
oFSO.DeleteFile oFile
Next
Set oTemp = oFSO.GetFolder(oFolder.Path & "\Temp")
For Each oFile In oTemp.Files
oFSO.MoveFile oFile, oFolder.Path & "\" & oFile.Name
Next

[EINSTEIN_007]

As you already know what the three lines at the top of the file are, open a new file, write the three lines, then open and append the Access generated file to the new one. You cannot prepend new lines to a file or add lines at the beginning of a file. So what you are doing here is to create the new file and add existing lines.

[Kazz013]

Thanks for your quick reply EINSTEIN_007

I've tried a few expansions of code and posted the problemmatic attempt below and keep getting the wrong results... in this attempt (of many) the 3rd file populates with file 2's data!

Attached Source servers.txt and the results.zip

Here is the script that I keep getting wrong, appreciate the help!

sFolder = "c:\dev1"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sFolder)
If oFSO.FolderExists(sFolder & "\Temp") _
Then oFSO.DeleteFolder sFolder & "\Temp"
oFSO.CreateFolder(oFolder.Path & "\Temp")

For Each oFile In oFolder.Files
sName1 = oFile.ParentFolder & "\Temp\" & oFile.Name
sName2 = oFile.ParentFolder & "\Temp\" _
& Left(oFile.Name, Len(oFile.Name) - 5) & "2.txt"
sName3 = oFile.ParentFolder & "\Temp\" _
& Left(oFile.Name, Len(oFile.Name) - 5) & "3.txt"
Set oTextFile = oFSO.OpenTextFile(oFile, 1)
Set oOut1 = oFSO.CreateTextFile(sName1)
Set oOut2 = oFSO.CreateTextFile(sName2)
Set oOut3 = oFSO.CreateTextFile(sName3)
sText = oTextFile.Readall
aText = Split(sText, VbCrLf)
For i = 0 To UBound(aText) \ 2
oOut1.WriteLine aText(i)
Next
For i = UBound(aText) \ 2 + 1 To UBound(aText)
oOut2.WriteLine aText(i)
Next
For i = UBound(aText) \ 2 + 1 To UBound(aText)
oOut3.WriteLine aText(i)
Next
oTextFile.Close
oOut1.Close
oOut2.Close
oOut3.Close
Next

[Kazz013]

Tinker Tinker FIX!!! worked it out... happy to share my Hack. Comments? Advice?

'SET THE ENVIRONMENT UP
sFolder = "c:\dev1"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sFolder)
If oFSO.FolderExists(sFolder & "\Temp") _
Then oFSO.DeleteFolder sFolder & "\Temp"
oFSO.CreateFolder(oFolder.Path & "\Temp")
oFSO.CreateFolder(oFolder.Path & "\RESULT")
oFSO.CreateFolder(oFolder.Path & "\SOURCE.Backup")

'BACKUP SOURCE FILE
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile "c:\dev1\*.*" , "c:\dev1\source.backup"

'BEGIN SPLITTING FILE INTO THREE
For Each oFile In oFolder.Files
sName1 = oFile.ParentFolder & "\Temp\" & oFile.Name
sName2 = oFile.ParentFolder & "\Temp\" _
& Left(oFile.Name, Len(oFile.Name) - 5) & "2.txt"

Set oTextFile = oFSO.OpenTextFile(oFile, 1)
Set oOut1 = oFSO.CreateTextFile(sName1)
Set oOut2 = oFSO.CreateTextFile(sName2)

sText = oTextFile.Readall
aText = Split(sText, VbCrLf)
For i = 0 To UBound(aText) \ 3
oOut1.WriteLine aText(i)
Next
For i = UBound(aText) \ 3 + 1 To UBound(aText)
oOut2.WriteLine aText(i)
Next
oTextFile.Close
oOut1.Close
oOut2.Close
Next

'MOVE THE 1/3 RESULT & CONTINUE SPLITTING THE FILE
Set oTemp = oFSO.GetFolder(oFolder.Path & "\Temp")
oFSO.MoveFile "c:\dev1\temp\*.*", "c:\dev1\result\"
oFSO.DeleteFile "c:\dev1\*.*"

'COPY THE RESULTS
Const OverwriteExisting = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile "c:\dev1\result\*2.*" , "c:\dev1\", OverwriteExisting

'******FINISHED FIRST PASS*****************************

'COMMENCE FINAL PASS TO POPULATE 2/3 AND 3/3
For Each oFile In oFolder.Files
sName1 = oFile.ParentFolder & "\Temp\" & oFile.Name
sName2 = oFile.ParentFolder & "\Temp\" _
& Left(oFile.Name, Len(oFile.Name) - 5) & "3.txt"

Set oTextFile = oFSO.OpenTextFile(oFile, 1)
Set oOut1 = oFSO.CreateTextFile(sName1)
Set oOut2 = oFSO.CreateTextFile(sName2)

sText = oTextFile.Readall
aText = Split(sText, VbCrLf)
For i = 0 To UBound(aText) \ 2
oOut1.WriteLine aText(i)
Next
For i = UBound(aText) \ 2 + 1 To UBound(aText)
oOut2.WriteLine aText(i)
Next
oTextFile.Close
oOut1.Close
oOut2.Close
Next

'COPY THE RESULTS
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile "c:\dev1\temp\*.*" , "c:\dev1\result", OverwriteExisting

'CLEANUP
If oFSO.FolderExists(sFolder & "\Temp") _
Then oFSO.DeleteFolder sFolder & "\Temp"
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile("C:\dev1\*.*")
objFSO.CopyFile "c:\dev1\source.backup\*.*" , "c:\dev1\"