CODEWITHSUNDEEP
excelvba
DESA
DESA

Reputation: 1

Search for a file in folders and sub folders using file name if found copy to another folder in vba macros

Search for a file in folders and sub folders using file name if found copy to another folder in vba macros The code shows no error but the file is not copying from the folder, i need to loop through sub folders and find a file.

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

Upvotes: 0

Views: 953

Answers (2)

DESA
DESA

Reputation: 1

Here is the answer i found
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 InStr(1, fsofile.Name, 566978 & "_PTA") = 1 Then
            fsofile.Copy destinationpath
            End If
            Next
        Next
    End If
End Sub

Upvotes: 0

Slaqr
Slaqr

Reputation: 563

You're searching for the number using the Right-function, but this fails to take into account the file-extension that follows it. You could try something like (assuming the extension is the same): 

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

If the file-extensions aren't of the same length, you could determine the position of the dot in the name and use the Mid-function.

Alternatively, you could just check if the numbers you're looking for occur within the filename using, instead of the Right-function:

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

This should only cause issues if there are files with longer strings of numbers, because for example you could have a file named "123556978123.pdf", which would be a false positive.

Upvotes: 1

Related Questions