Option Explicit

Dim BoxIn, AllFol
AllFol = Array("Z:\Box_In", _
            "Z:\Soft_In")

Dim FSO, App, Fol, Itm, File, S, SS, Reg, num, i, Max
Set FSO = CreateObject("Scripting.FileSystemObject")
Set App = CreateObject("Shell.Application")
Set Reg = CreateObject("VBScript.RegExp"): Reg.Global = True

For Each BoxIn In AllFol
    Set Fol = App.Namespace(BoxIn)
    Set Itm = Fol.Items()
    Itm.Filter 64 + 128, "*.txt"

    ReDim AllOut(9999)
    For Each File In Itm
        File = BoxIn + "\" + File.Name
        With FSO.OpenTextFile(File, 1, False)
            Max = 0
            Do While Not .AtEndOfStream
                SS = .ReadLine
                If SS <> Empty Then
                    S = Split(SS, "/")
				i = UBound(S)
                    num = FSO.GetBaseName(S(i))
                    If Reg.Test(num) Then
                        Reg.Pattern = "\D"
                        num = CLng(Reg.Replace(num, ""))
                        If num <= 9999 Then
                            If Max < num Then Max = num
                            AllOut(num) = SS
                        End If
                    End If
                End If
            Loop
            .Close
        End With
        
        With FSO.OpenTextFile(File, 2, True)
            For i = 1 To Max
                If AllOut(i) <> Empty Then .WriteLine (AllOut(i))
            Next
            .Close
        End With
    Next
Next