CodeItBetter Programming Another VB Programming Blog

Option Explicit
Option Compare Text
 
Public Sub SortTextFile(pstrFile As String)
   Dim strLine() As String
 
   strLine = Split(LoadFileToString(pstrFile), vbNewLine)
   QuickSort1 strLine
   SaveStringToFile Join(strLine, vbNewLine), pstrFile
End Sub
 
Public Function LoadFileToString(pstrFile As String) As String
   Dim bytArray() As Byte
   Dim strReturn as String
   Dim FileNumber As Long
 
   FileNumber = FreeFile
   Open pstrFile For Binary Access Read As #FileNumber
   ReDim bytArray(LOF(FileNumber) - 1)
   Get #FileNumber, 1, bytArray
   Close #FileNumber
   strReturn = StrConv(bytArray, vbUnicode)
   Erase bytArray
   Do While Instr(strReturn, vbNewLine & vbNewline)
       strReturn = Replace(strReturn, vbNewLine & vbNewline, vbNewLine)
   Loop
   Do While Right(strReturn, 2) = vbNewLine
       strReturn = Left(strReturn, Len(strReturn) - 2)
   Loop
   LoadFileToString = strReturn
End Function
 
Public Sub SaveStringToFile(pstrText As String, pstrFile As String)
   Dim FileNumber As Long
 
   If Len(Dir(pstrFile)) Then Kill pstrFile
   FileNumber = FreeFile()
   Open pstrFile For Output As #FileNumber
   Print #FileNumber, pstrText
   Close
End Sub
 
' Omit plngLeft & plngRight; they are used internally during recursion
Public Sub QuickSort1(ByRef pvarArray As Variant, Optional ByVal plngLeft As Long, Optional ByVal plngRight As Long)
   Dim lngFirst As Long
   Dim lngLast As Long
   Dim varMid As Variant
   Dim varSwap As Variant
 
   If plngRight = 0 Then
       plngLeft = LBound(pvarArray)
       plngRight = UBound(pvarArray)
   End If
   lngFirst = plngLeft
   lngLast = plngRight
   varMid = pvarArray((plngLeft + plngRight) \ 2)
   Do
       Do While pvarArray(lngFirst) < varMid And lngFirst < plngRight
           lngFirst = lngFirst + 1
       Loop
       Do While varMid < pvarArray(lngLast) And lngLast > plngLeft
           lngLast = lngLast - 1
       Loop
       If lngFirst <= lngLast Then
           varSwap = pvarArray(lngFirst)
           pvarArray(lngFirst) = pvarArray(lngLast)
           pvarArray(lngLast) = varSwap
           lngFirst = lngFirst + 1
           lngLast = lngLast - 1
       End If
   Loop Until lngFirst > lngLast
   If plngLeft < lngLast Then QuickSort1 pvarArray, plngLeft, lngLast
   If lngFirst < plngRight Then QuickSort1 pvarArray, lngFirst, plngRight
End Sub
 
'How to use this routine:
'call SortTextFile ("C:\Temp\testFile.txt")