read write format text files

[jamesedward]

Hi all,
I am using EXCEL 2007. I have 300+ text files that I need to edit. I would like the entire code, as this is out of my range.

If the second line of the file_1 is greater than zero then
take that number and multiply by 4 (that equals the number of lines to remove/skip)
Make the second line a zero and skip the next number of lines (by the multiplied number)

before: file_1
36
2
0.00 0.00 0.00
0.00 0.00 0.00
0.00 0.00 0.00
500.0 250.0 500.0
0.00 0.00 0.00
0.00 0.00 0.00
0.00 0.00 0.00
600.0 250.0 600.0

after: file_2
36
0

If second line of file is zero, close file. No reformatting required.

After this reformatting is complete, keep the remainder of the file format the same.

Need a file navigator
The original file should be renamed with the .orig extension
The new file should inherit the original file name

[Teeroy]

Hi jamesedward,

The following should work for you but you'll have to change the file folder location. It assumes per your example files that the original file has no extension and appends the .orig if changes are made. I've kept it simple and designed for a single pass only so if you run it more than once you may get .orig.orig and so on (as they'll fit the conditions to modify the file).

[vba]'IMPORTANT: Need to set a VBE reference to Microsoft Scripting Runtime

Sub deleteLines()
Dim objFSO As Object 'FileSystemObject
Dim objTxt As Object 'TextStream
Dim vData As Variant, vProcess As Variant
Dim fls As Files
Dim f As File
Dim i As Integer

Const ForReading = 1, ForWriting = 2, ForAppending = 8

'******************************************************************
'Create a FSO to interface to the filesystem.
'Get files collection and step through it
'******************************************************************
Set objFSO = CreateObject("Scripting.FileSystemObject")
'get Files collection of folder
Set fls = objFSO.GetFolder("C:\Test").Files
For Each f In fls 'step through files collection
Set objTxt = objFSO.OpenTextFile(f.Path, ForReading, False)
vData = Split(objTxt.ReadAll, vbCrLf)
If vData(1) > 0 Then
'copy the backup file
objFSO.CopyFile f.Path, f.Path & ".orig"
Set objTxt = objFSO.OpenTextFile(f.Path, ForWriting, True)
'process line removal and write new file data ingoring the lines to be deleted
objTxt.WriteLine (vData(0))
objTxt.WriteLine ("0")
For i = 4 * vData(1) + 2 To UBound(vData)
objTxt.WriteLine (vData(i))
Next i
objTxt.Close
End If
Next
Set fls = Nothing
Set objFSO = Nothing

End Sub[/vba]

[shrivallabha]

Hi Teeroy,

You can surely early bind FSO and TextStream as you are setting reference to "Microsoft Scripting Runtime"

i.e.
[VBA]Dim objFSO As Object 'FileSystemObject
Dim objTxt As Object 'TextStream[/VBA]
could be:
[VBA]Dim objFSO As FileSystemObject
Dim objTxt As TextStream[/VBA]

[Teeroy]

Hi shrivallabha,

You're right. I cobbled this together quickly from two other code pieces I had, one an early bind and one a late bind and posted before cleaning it up. With the early bind you can also drop the const line and simplify the FSO instantiation.

jamesedward,

The code below has been cleaned up per shrivallabha's observation and may be slightly quicker. You probably wouldn't notice the speed change in one file but over 300 you might!

[VBA]
Sub deleteLines()

Dim vData As Variant
Dim i As Integer


'early Bind
'IMPORTANT: Need to set a VBE reference to Microsoft Scripting Runtime
Dim objFSO As FileSystemObject
Dim objTxt As TextStream
Dim fls As Files
Dim f As File


'******************************************************************
'Create a FSO to interface to the filesystem.
'Get files collection and step through it
'******************************************************************
Set objFSO = New FileSystemObject
'get Files collection of folder
Set fls = objFSO.GetFolder("C:\Test").Files
For Each f In fls 'step through files collection
Set objTxt = objFSO.OpenTextFile(f.Path, ForReading, False)
vData = Split(objTxt.ReadAll, vbCrLf)
If vData(1) > 0 Then
'copy the backup file
objFSO.CopyFile f.Path, f.Path & ".orig"
Set objTxt = objFSO.OpenTextFile(f.Path, ForWriting, True)
'process line removal and write new file data ingoring the lines to be deleted
objTxt.WriteLine (vData(0))
objTxt.WriteLine ("0")
For i = 4 * vData(1) + 2 To UBound(vData)
objTxt.WriteLine (vData(i))
Next i
objTxt.Close
End If
Next
Set fls = Nothing
Set objFSO = Nothing

End Sub

[/VBA]