Checking for CR/LF in text file.

[Erazmus]

Hi Guys,

Does anyone know how I would check that each line of a text file is
terminated with a CR/LF pair?

My macro needs to check the formatting of each line of a CSV file to
make sure it will load properly into a different application (This
part is nice and easy). Because each record/line in the file is
transactional in nature Excel is perfect for this but the one quirky
thing is that each line in the file must be terminated with a CR/LF
pair.

Any help will be appreciated.

I've tried working with something like this but each method reads the
line before termination? -

....
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("C:\TEST.TXT", ForReading, TristateTrue)
currentLine = f.ReadLine
....
and also
....
Open "C:\TEST.TXT" For Binary As #1
Line Input #1, LineofText
....

Cheers,
Deon Murtagh

 

[Joel]

You have to read one character at a time and check that CR is followed by LF

Sub test()

Const LF = 10
Const CR = 13

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")

Set readfile = fs.OpenTextFile("c:\temp\readfile.txt", _
ForReading, TristateFalse)
fs.CreateTextFile "c:\temp\writefile.txt"
Set writefile = fs.OpenTextFile("c:\temp\writefile.txt", _
ForWriting, TristateFalse)

CR_CHAR = False
Do While readfile.atendofstream = False
newchar = readfile.read(1)

Select Case Asc(newchar)

Case LF
If CR_CHAR = False Then
'case LF without CR
writefile.write Chr(CR)
Else
'reset status after CR then LF
CR_CHAR = False
End If
Case CR
CR_CHAR = True
Case Else
If CR_CHAR = True Then
'case CR without LF
writefile.write Chr(LF)
CR_CHAR = False
End If

End Select

writefile.write newchar
Loop

readfile.Close
writefile.Close


End Sub

 

[Joel]

If forgot the case where two carriage turns are in a row

Sub test()

Const LF = 10
Const CR = 13

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")

Set readfile = fs.OpenTextFile("c:\temp\readfile.txt", _
ForReading, TristateFalse)
fs.CreateTextFile "c:\temp\writefile.txt"
Set writefile = fs.OpenTextFile("c:\temp\writefile.txt", _
ForWriting, TristateFalse)

CR_CHAR = False
Do While readfile.atendofstream = False
newchar = readfile.read(1)

Select Case Asc(newchar)

Case LF
If CR_CHAR = False Then
'case LF without CR
writefile.write Chr(CR)
Else
'reset status after CR then LF
CR_CHAR = False
End If
Case CR
If CR_CHAR = True Then
'case CR followed by CR
writefile.write Chr(LF)
else
CR_CHAR = True
End If
Case Else
If CR_CHAR = True Then
'case CR without LF
writefile.write Chr(LF)
CR_CHAR = False
End If

End Select

writefile.write newchar
Loop

readfile.Close
writefile.Close


End Sub

 

[NickHK]

Depends how you are defining a line ?

In Windows text files, it is vbCrLf, so if that character combination is not
present, then is not the end of the line, by definition.
If you have some additional information that a "line" consists of say 100
characters/bytes, then you know the answer.

I suspect the real question is that you data is coming from a non-windows
source that uses LF or similar as the end of line marker. If so, standard
VBA routine will not recognise it.
Assuming the file is not too large (< ~ 20MB), you can do a Replace on the
whole string to get it in the correct format. If you file is similar to that
created by the routine "CreateNonWinFile" below, then the routine
"FixNonWinFile" will fix it. However, depending what you are doing, you may
not need to write the file; dump to the WS instead:

Private Sub CommandButton2_Click()

Const NonWinFile As String = "C:\Test.txt"
Const WinFile As String = "C:\Test-Fixed.txt"

Call CreateNonWinFile(Worksheets(1).Range("A1:A10"), NonWinFile)

Call FixNonWinFile(NonWinFile, WinFile)

End Sub

Private Function FixNonWinFile(InputFilePathName As String,
OutputFilePathName As String)
Dim FileNum As Long
Dim TempStr As String

FileNum = FreeFile
Open InputFilePathName For Input As #FileNum
'Read in the whole file
TempStr = Input(LOF(FileNum), #FileNum)
Close #FileNum

FileNum = FreeFile
Open OutputFilePathName For Output As #FileNum
'Write out the whole corrected string
Print #FileNum, Replace(TempStr, vbLf, vbCrLF) 'vbNewLine
Close #FileNum

'Or dump to the WS if you do not need to corrected file
Dim Arr As Variant

Arr = Split(TempStr, vbLf)
Worksheets(2).Range("A1").Resize(UBound(Arr)) =
Application.WorksheetFunction.Transpose(Arr)

End Function

Private Function CreateNonWinFile(DataCol As Range, FilePathName As String)
Dim Cell As Range
Dim TempStr As String
Dim FileNum As Long

For Each Cell In DataCol
TempStr = TempStr & Cell.Value & vbLf
Next

FileNum = FreeFile
Open FilePathName For Output As #FileNum
Print #FileNum, TempStr
Close #FileNum

End Function

NickHK

 

[Dave Peterson]

If this is something you do lots of times, you may want to get a dedicated
program that does this kind of thing.

If you search www.shareware.com for Unix2Dos (and Dos2Unix), you'll find lots of
hits.

 

[Dave Peterson]

In fact, some text editors can convert this kind of stuff, too.

I use UltraEdit (www.ultraedit.com) and it has this ability.

 

[Erazmus]

Many thanks to you all for your replies.

Joel's is perfect for the situation, came down to me not realising how
to check each character in the file and gives me something to work
from there.

Cheers again