[megaloman]

добавил восстановление регистра ... исправил лишнее добавление пустой строки »

Вариант, где этого делать не надо. Не думал, что регистр в путях имеет какое-то значение

Код:

FileIn = "Z:\Box_In\filein.txt"
FileOut = "Z:\Box_Out\fileout.txt"

Set FSO = CreateObject("Scripting.FileSystemObject")

On Error Resume Next

With FSO.OpenTextFile(FileIn, 1, False)
    If Err.Number <> 0 Then
        MsgBox "File   " + FileIn + vbCrLf + Err.Description + "(" + CStr(Err.Number) + ")"
        WScript.Quit 2
    End If
    On Error GoTo 0

    Alls = Split(.ReadAll, vbCrLf)
    .Close
End With

N = -1
ND = -1
NF = -1
For Each s In Alls
    N = N + 1
    s = Trim(s)
    Alls(N) = s
    If Len(s) <> 0 Then
        If Right(s, 1) = "\" Then ND = ND + 1 Else NF = NF + 1
    End If
Next

ReDim MasD(ND), MasF(NF)
jD = -1
jF = -1
For i = 0 To N
    s = Alls(i)
    If Len(s) <> 0 Then
        If Right(s, 1) = "\" Then
            jD = jD + 1
            MasD(jD) = Replace(Alls(i), "\", Chr(0))
        Else
            jF = jF + 1
            MasF(jF) = Replace(Alls(i), "\", Chr(0))
        End If
    End If
Next
Set Alls = Nothing

Call SortMas(MasD, ND)
Call SortMas(MasF, NF)

out = ""
For i = 0 To ND
    D = LCase(MasD(i))
    For j = 0 To NF
        If InStr(1, LCase(MasF(j)), D) <> 0 Then
            If out = "" Then out = MasF(j) Else out = MasF(j) + vbCrLf + out
            MasF(j) = ""
        End If
    Next
    If out = "" Then out = MasD(i) Else out = MasD(i) + vbCrLf + out
Next

For j = 0 To NF
    If MasF(j) <> "" Then out = MasF(j) + vbCrLf + out
Next
out = Replace(out, Chr(0), "\")
'MsgBox out  '''''''''''''''''''''''

With FSO.CreateTextFile(FileOut, True)
    .Write out
    .Close
End With
MsgBox "Done"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''End

Sub SortMas(Mas, NMas)
    For i = 0 To NMas
        s = LCase(Mas(i))
        For j = i To NMas
            ss = LCase(Mas(j))
            If s < ss Then
                s = Mas(i)
                Mas(i) = Mas(j)
                Mas(j) = s
                s = LCase(Mas(i))
            End If
        Next
    Next
End Sub