Private Sub Command1_Click()
Dim Text As String
Dim Nr As Integer
 
Nr = FreeFile
 
Open "D:\Test.txt" For Binary As Nr
Text = Space(LOF(Nr))
Get Nr, , Text
Close Nr
 
Do While InStr(1, Text, vbCrLf & vbCrLf)
 Text = Replace(Text, vbCrLf & vbCrLf, vbCrLf)
Loop
 
If Dir("D:\Test.txt") <> "" Then Kill "D:\Test.txt"
 
Nr = FreeFile
 
Open "D:\Test.txt" For Binary As Nr
Put Nr, , Text
Close Nr
 
End Sub