FileSystemObject

  • Thread starter Thread starter Phil Howard
  • Start date Start date
P

Phil Howard

Hi

I've got a fuinction which adds carriage returns to a text file:

Private Function Do_FS_Stream()
'Add Carriage Returns
Set fsin = CreateObject("Scripting.FileSystemObject")
Set fsout = CreateObject("Scripting.FileSystemObject")
Set fstream = fsin.opentextfile(ImportFilename)
Set fstreamout = fsout.createtextfile(ImportFilename & ".tmp")
'use temp file for replace
fstreamout.write (sReplace(fstream.readall, "'", "'" & vbCrLf))

Set fsin = Nothing
Set fsout = Nothing
Set fstream = Nothing
Set fstreamout = Nothing
DoEvents

'remove temp file
FileCopy ImportFilename & ".TMP", ImportFilename 'rename file
Kill ImportFilename & ".TMP"
End Function


This works perfectly, however sometimes files get reprocessed many
times so we end up with lots of carriage returns.

Is there any way, to check if the file contains carriage returns, and
then only put them in if it needs to.

Cheers
Graeme.
 
Phil said:
I've got a fuinction which adds carriage returns to a text file: [snip code]
This works perfectly, however sometimes files get reprocessed many
times so we end up with lots of carriage returns.

Is there any way, to check if the file contains carriage returns, and
then only put them in if it needs to.
Click to expand...

I would do this in an entirely different manner, something like this:

Sub addCRLF(filespec As String)
Dim f As String, fHnd As Long, fCnt As String, fOut As String
Dim L0 As Long
fCount = -1
f = Dir$(filespec)
While Len(f)
fHnd = FreeFile
Open f For Binary As fHnd
fCnt = Space$(LOF(fHnd))
Get #fHnd, 1, fCnt
fOut = Replace(fCnt, "'", "'" & vbCrLf)
Put #fHnd, 1, fOut
Close fHnd
f = Dir$
Wend
End Sub

To use this, just call the sub like this:
addCRLF "*.txt"

Or remove "filespec As String" and change Dir$(filespec) to Dir$("your
filespec here"), and call this sub directly.
 
What's going on in `sReplace` ? That's where you're going to have to
change your logic....

Tim
 
I'd 'dump' the entire file into an array using VB's standard file I/O
functions (rather than FSO) to read into a string, and VB's Split
function to put the lines into an array specifying 'vbCrLf' as the
delimiter.

Use VB's 'Filter' function to clear the array of empty elements (extra
'vbCrLf' lines) so the array ends up with only lines of data. 'Dump'
the array back into a string using VB's 'Join' function and specifying
'vbCrLf' as the delimiter. Then 'dump' the string back into the file.

Some reusable functions...

Read from file:

Function ReadTextFileContents(Filename As String) As String
' A reuseable procedure to read large amounts of data from a text file
in one single step.
Dim iNum As Integer
On Error GoTo ErrHandler
iNum = FreeFile(): Open Filename For Input As #iNum
ReadTextFileContents = Space$(LOF(iNum))
ReadTextFileContents = Input(LOF(iNum), iNum)

ErrHandler:
Close #iNum: If Err Then Err.Raise Err.Number, , Err.Description
End Function 'ReadTextFileContents()


Write to file:

Sub WriteTextFileContents(Text As String, Filename As String, Optional
AppendMode As Boolean = False)
' A reuseable procedure to write, overwrite, or append large amounts of
data
' to a text file in one single step.
Dim iNum As Integer
On Error GoTo ErrHandler
iNum = FreeFile()
If AppendMode Then
Open Filename For Append As #iNum: Print #iNum, vbCrLf & Text;
Else
Open Filename For Output As #iNum: Print #iNum, Text;
End If

ErrHandler:
Close #iNum: If Err Then Err.Raise Err.Number, , Err.Description
End Sub 'WriteTextFileContents()

***Note that the 'Print' statement lines end with a semi-colon to avoid
extra lines at the end of the file. This write procedure does not add
extra lines and so when appending to the file a vbCrLf needs to be put
in front of the text.***

Filtering out the empty lines of an existing file:

Dim vText As Variant, sTextIn As String

sTextIn = ReadTextFileContents(<full_filename>)
vText = Split(sTextIn, vbCrLf)
vText = Filter(vText, "", False)

Write back to the file:

WriteTextFileContents(Join(vText, vbCrLf), <full_filename>)


Append to file:

WriteTextFileContents(Join(vText, vbCrLf), <full_filename>, True)
 
Back
Top