Любой язык - [решено] Заменить ссылки в txt файле, найдя одинаковые номера

megaloman · Отправлено: **17:40, 18-12-2023** | #11

Alexander_88, чтобы быстро и с сортировкой по возрастанию - vbs

Код:

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

В прикрепленном файле уберите расширение .txt и пропишите пути к своим папкам

Alexander_88 · Отправлено: **21:47, 19-12-2023** | #12

а куда выходит результирующий файл? или он заменяется?

Код:

Option Explicit

Dim BoxIn, AllFol
AllFol = Array("C:\Work\CONTENT")
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, "fileslink.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

что то ничего не происходит, наверное пути не правильно поставил.

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

Цитата 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

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

Alexander_88 · Отправлено: **07:59, 21-12-2023** | #14

megaloman, спасибо, все получилось, заменяет 800 ссылок очень быстро