Имя пользователя:
Пароль:
 

Показать сообщение отдельно

Ветеран


Contributor


Сообщения: 2735
Благодарности: 1699

Профиль | Отправить PM | Цитировать


Вложения
Тип файла: zip Work20.zip
(2.9 Kb, 15 просмотров)

Цитата Alexander_88:
есть несколько txt файлов »
Вы жестко забили в фильтре 1 файл fileslink.txt по 1 пути "C:\Work\CONTENT"
Такой файл имеется? Тут архив тестового комплекта. На нём работает.
Вот вариант скрипта с проверкой существования файла(ов)
Код: Выделить весь код
Option Explicit

Dim BoxIn, AllFol
AllFol = Array("C:\Work\CONTENT")                   '("Z:\Box_In", "Z:\Soft_In")
Const Mask = "fileslink.txt"                        '"*.txt"

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, Mask
    If Itm.Count <> 0 Then
        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
    Else
        MsgBox "File(s)" + vbCr + BoxIn + "\" + Mask + vbCr + "not found", 16, "Not found"
    End If
Next

Результирующий файл заменяется.
Иное делается "на раз".

-------
Даже самая сложная проблема обязательно имеет простое, лёгкое для понимания, неправильное решение. Каждое решение плодит новые проблемы.

Это сообщение посчитали полезным следующие участники:

Отправлено: 07:24, 20-12-2023 | #13