Split Text File

[HartSA]

Is there a way with VBS to split a text file into two separate text files?
I have a file I need to import into Excel and it is 100,000 lines, Excel
only handles 60,000+.

[HartSA]

OK. I found another workaround I think. I want to delete all the blank
lines and re-write to another text file.

On Error Resume Next
Const ForReading = 1
Const ForWriting = 2

Dim FSO, FS1, RF1
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FS1 = FSO.OpenTextFile("deml.txt", ForReading)
Set RF1 = FSO.OpenTextFile("deml1.txt", ForWriting)

Do While Not FS1.AtEndOfStream
RS1 = FS1.ReadLine

If Len(rs1) > 0 Then
RF1.WriteLine(RS1)
End If

Loop

FS1.Close
RF1.Close

msgbox ("Done")

It makes it to the if statement, but doesn't write to the new text file.

"HartSA" <dvan...@tcny.com> wrote in message
news:u4lEjW7F...@TK2MSFTNGP15.phx.gbl...

[Evertjan.]

HartSA wrote on 12 jan 2006 in microsoft.public.scripting.vbscript:

> Dim FSO, FS1, RF1
> Set FSO = CreateObject("Scripting.FileSystemObject")
> Set FS1 = FSO.OpenTextFile("deml.txt", ForReading)
> Set RF1 = FSO.OpenTextFile("deml1.txt", ForWriting)
>

Set RF1 = FSO.OpenTextFile("deml1.txt", ForWriting, true)

Needs "true" for creating a new file.

<http://msdn.microsoft.com/library/default.asp?url=/library/en-
us/script56/html/0bb47056-1e5b-4d51-9fb3-9fa12d4ec90c.asp>

--
Evertjan.
The Netherlands.
(Please change the x'es to dots in my emailaddress)

[Al Dunbar]

"Evertjan." <exjxw.ha...@interxnl.net> wrote in message
news:Xns9749E48...@194.109.133.242...

> HartSA wrote on 12 jan 2006 in microsoft.public.scripting.vbscript:
>
>> Dim FSO, FS1, RF1
>> Set FSO = CreateObject("Scripting.FileSystemObject")
>> Set FS1 = FSO.OpenTextFile("deml.txt", ForReading)
>> Set RF1 = FSO.OpenTextFile("deml1.txt", ForWriting)
>>
>
> Set RF1 = FSO.OpenTextFile("deml1.txt", ForWriting, true)
>
> Needs "true" for creating a new file.
>
> <http://msdn.microsoft.com/library/default.asp?url=/library/en-
> us/script56/html/0bb47056-1e5b-4d51-9fb3-9fa12d4ec90c.asp>

Below is another approach. It reads in the entire file, converts all
linefeeds to carriage returns, converts any groups of carriage returns to a
single one, converts all remaining carriage returns to the end of line
character of your choice. I have used vbnewline, but you could use vbcr or
vblf.

On Error Resume Next
Const ForReading = 1
Const ForWriting = 2

Const eolstring = vbnewline

Dim FSO, FS1, RF1, fileimage

Set FSO = CreateObject("Scripting.FileSystemObject")
Set FS1 = FSO.OpenTextFile("deml.txt", ForReading)

Set RF1 = FSO.OpenTextFile("deml1.txt", ForWriting, true)

fileimage = FS1.ReadAll
fileimage = Replace(fileimage,vbLf,vbCr)
imagesize = Len(fileimage)
Do
lastsize = imagesize
fileimage = Replace(fileimage, vbcr & vbcr, vbcr)
imagesize = Len(fileimage)
Until lastsize = imagesize

fileimage = Replace(fileimage, vbcr, eolstring)

RF1.Write fileimage

FS1.Close
RF1.Close

msgbox ("Done")

/Al

[Evertjan.]

Al Dunbar wrote on 13 jan 2006 in microsoft.public.scripting.vbscript:

> fileimage = FS1.ReadAll
> fileimage = Replace(fileimage,vbLf,vbCr)
> imagesize = Len(fileimage)
> Do
> lastsize = imagesize
> fileimage = Replace(fileimage, vbcr & vbcr, vbcr)
> imagesize = Len(fileimage)
> Until lastsize = imagesize

Without the vbs loop:

fileimage = FS1.ReadAll
fileimage = Replace(fileimage,vbLf,vbCr)

Set regEx = New RegExp
regEx.Pattern = "\r\r+"
regEx.Global = True
fileimage = regEx.Replace(fileimage, vbCr)

[Miyahn]

"HartSA" wrote in message news:u4lEjW7F...@TK2MSFTNGP15.phx.gbl

> Is there a way with VBS to split a text file into two separate text files?
> I have a file I need to import into Excel and it is 100,000 lines, Excel
> only handles 60,000+.

How about importing to Excel's sheets directly?

' FileName : Ltxt2xls.vbs
Option Explicit
Const MaxLine = 65536
Dim tFile, xlBook, iBuf, oBuf, I, J, IMax, JMax
If WScript.Arguments.Count <> 1 Then WScript.Quit
tFile = WScript.Arguments(0)
With CreateObject("Scripting.FileSystemObject")
Select Case LCase(.GetExtensionName(tFile))
Case "csv", "txt", "prn"
With .OpenTextFile(tFile)
iBuf = Split(.ReadAll, vbCrLf): .Close
End With
With CreateObject("Excel.Application")
.Visible = True: Set xlBook = .Workbooks.Add(1)
End With
IMax = UBound(iBuf): JMax = MaxLine - 1
For I = 0 To IMax Step MaxLine
If I + MaxLine - 1 > IMax Then JMax = IMax - I
ReDim oBuf(IMax, 0)
For J = 0 To JMax: oBuf(J, 0) = iBuf(I + J): Next
xlBook.Activesheet.Range("A1:A" & J) = oBuf
With xlBook.Sheets: .Add , .Item(.Count): End With
Next
xlBook.Sheets(1).Select
Case Else
MsgBox "Drag and drop a text(csv/txt/prn) file !!"
End Select
End With

--
Miyahn (Masataka Miyashita) JPN
Microsoft MVP for Microsoft Office - Excel(Jan 2006 - Dec 2006)
HQF0...@nifty.ne.jp