Поиск файла в папках и подпапках по имени файла, если найдена копия в другую папку в макросах vba

Question

Поиск файла в папках и подпапках по имени файла, если найдена копия в другую папку в макросах vba Код не показывает ошибок, но файл не копируется из папки, мне нужно перебрать подпапки и найти файл.

Sub copy_files_from_subfolders()    
    Dim fso As Object
    Dim fld As Object
    Dim fsofile As Object
    Dim fsofol As Object

    sourcepath = "FINAL CUT\"
    destinationpath = "Desa\MECA\"

    If Right(sourcepath, 1) <> "\" Then
    sourcepath = sourcepath & "\"
    End If

    Set fso = CreateObject("scripting.filesystemobject")
    Set fld = fso.GetFolder(sourcepath)
    If fso.FolderExists(fld) Then
        For Each fsofol In fso.GetFolder(sourcepath).SubFolders
            For Each fsofile In fsofol.Files
                If Right(fsofile, 6) = 566978 Then
                fsofile.Copy destinationpath
            End If
            Next
        Next
    End If
End Sub

Answer 1

Вот ответ, который я нашел
Sub copy_files_from_subfolders ()
Dim fso как объект Dim fld как объект Dim fsofile как объект Dim fsofol как объект

    sourcepath = "FINAL CUT\"
    destinationpath = "Desa\MECA\"

    If Right(sourcepath, 1) <> "\" Then
    sourcepath = sourcepath & "\"
    End If

    Set fso = CreateObject("scripting.filesystemobject")
    Set fld = fso.GetFolder(sourcepath)
    If fso.FolderExists(fld) Then
        For Each fsofol In fso.GetFolder(sourcepath).SubFolders
            For Each fsofile In fsofol.Files
                If InStr(1, fsofile.Name, 566978 & "_PTA") = 1 Then
            fsofile.Copy destinationpath
            End If
            Next
        Next
    End If
End Sub

Answer 2

Вы ищете номер, используя функцию Right, но при этом не учитывается расширение файла, которое следует за ним.Вы можете попробовать что-то вроде (при условии, что расширение одно и то же):

Right(fsofile, 10) = "566978.txt" ''change extension to whatever

Если расширения файла не имеют одинаковую длину, вы можете определить положение точки в имени и использоватьMid-function.

В качестве альтернативы, вы можете просто проверить, встречаются ли искомые числа в имени файла, вместо функции Right:

If InStr(1, fsofile, "566978") <> 0 then

Это должно вызывать толькопроблемы, если есть файлы с более длинными строками чисел, потому что, например, у вас может быть файл с именем "123556978123.pdf", который будет ошибочным.