Using partial file names in an excel table to match and copy files to a subfolder

[AnthonyDavisSF]

I'm trying to match using partial file names, then copy all matching files to a subfolder within the source folder.

This is another users pic, but I'm trying to use "TPS" from column D to copy the "TPS report" file into a new folder called "found files" located inside the "document folder" source folder.

Basically, I've got a list of PO#s and a folder with all those POs saved in it, but the full file names have a bunch of extraneous data after the PO# so I'd like to just use those to match them. I found some code from another user (@Subodh_Tiwari_sktneer), but I'm hoping someone can help me tweak it a bit, as I can't seem to get the code to work...

I've gotten it to create the subfolder in the source folder, but I would like to have the program search for partial file names instead of whole names (ex: search for 20448 results in the file labeled: 20448 xxxx-xxxxxxxxxx, xxx-xxx, xxxxx-xx)

CODE:

Sub SearchFiles()
Dim ws                      As Worksheet
Dim tbl                     As ListObject
Dim cel                     As Range
Dim rootFolder              As String
Dim strNameNewSubFolder     As String
Dim fso                     As FileSystemObject
Dim newFolder               As Folder
Dim fil                     As File
Dim strFilepath             As String
Dim newFilePath             As String

Set fso = New FileSystemObject
Set ws = Worksheets("B")
Set tbl = ws.ListObjects(1)

'Path of the Source folder with files
rootFolder = "C:\Users\sktneer\Documents"

If Not fso.FolderExists(rootFolder) Then
    MsgBox rootFolder & " doesn't exist.", vbExclamation, "Source Folder Not Found!"
    Exit Sub
End If

'files that are found in the Source Folder would be copied to this New Sub-Folder
'Change the name of the Sub-Folder as per your requirement
strNameNewSubFolder = "Found Files"

If Right(rootFolder, 1) <> "/" Then rootFolder = rootFolder & "/"

If Not fso.FolderExists(rootFolder & strNameNewSubFolder) Then
    fso.CreateFolder rootFolder & strNameNewSubFolder
End If

Set newFolder = fso.GetFolder(rootFolder & strNameNewSubFolder)

tbl.DataBodyRange.Columns(4).Interior.ColorIndex = xlNone

For Each cel In tbl.DataBodyRange.Columns(4).Cells
    strFilepath = rootFolder & cel.Value
    newFilePath = newFolder.Path & "/" & cel.Value
    If fso.FileExists(strFilepath) Then
        cel.Interior.Color = vbYellow
        Set fil = fso.GetFile(strFilepath)
        'The following line will copy the file found to the newly created Sub-Folder
        fil.Copy newFilePath
    End If
Next cel
Set fso = Nothing
End Sub

I'm wondering what I would need to add to this code to have it return the correct files using partial file names. Any and all help is massively appreciated.

Thanks in advance!

[#2]

 https://b23.tv/ezcAe8b 

How about using regular expression to move file like this?

[#3]

Sorry but I'm pretty new to all this and watching the video you posted unfortunately didn't make sense to me. I'm sure the code works fine, I just can't understand it yet as a newbie haha. Thank you though! I'll do some searching and see if I can't figure out how to follow along with what you're doing in the video.

[#4]

After you download and unzip the rgReanme.zip,you will find an exe file rgRename.exe.
This is an executive file for command line.
It will iterate all files in same path of the rgRename.exe when run once.

e.g.
if you have created a sub folder subA,you want move 20448 xxxx-xxxxxxxxxx.xlsx to subA/20448 xxxx-xxxxxxxxxx.xlsx
rgRename.exe 20448 subA/20448

then for batch actions
use bat.
e.g.
a.bat
rgRename.exe 20448 subA/20448
rgRename.exe 20449 subA/20449

[#5]

To search for partial file names and copy them to a new subfolder using VBA, you can utilize the `FileSystemObject` from the Microsoft Scripting Runtime library. Here's an example:

```vba
Sub SearchAndCopyFiles()
Dim fso As Object ' FileSystemObject
Dim sourceFolder As String
Dim destinationFolder As String
Dim fileNamePattern As String
Dim file As Object ' File
Dim foundFilesCount As Integer

' Set the source folder path
sourceFolder = "C:\Path\To\Source\Folder"

' Set the destination folder path
destinationFolder = "C:\Path\To\Destination\Folder\Found Files"

' Set the partial file name pattern
fileNamePattern = "*20448*"

' Create a FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")

' Check if the source folder exists
If Not fso.FolderExists(sourceFolder) Then
MsgBox "Source folder does not exist."
Exit Sub
End If

' Check if the destination folder exists and create it if not
If Not fso.FolderExists(destinationFolder) Then
On Error Resume Next
fso.CreateFolder destinationFolder
On Error GoTo 0

' Check if the creation was successful
If Not fso.FolderExists(destinationFolder) Then
MsgBox "Unable to create the destination folder."
Exit Sub
End If
End If

' Loop through all files in the source folder
For Each file In fso.GetFolder(sourceFolder).Files
' Check if the file name matches the pattern
If fso.GetFileName(file.Path) Like fileNamePattern Then
' Copy the file to the destination folder
fso.CopyFile file.Path, destinationFolder & "\" & fso.GetFileName(file.Path)
foundFilesCount = foundFilesCount + 1
End If
Next file

MsgBox "Found files: " & foundFilesCount
End Sub
```

In the code above, you need to set the `sourceFolder` variable to the path of the folder where you want to search for files. Set the `destinationFolder` variable to the path of the folder where you want to copy the found files. The `fileNamePattern` variable represents the partial file name pattern you want to search for (e.g., "*20448*").

The code uses the `FileSystemObject` to check if the source and destination folders exist. If the destination folder doesn't exist, it is created. Then, it loops through all files in the source folder and checks if the file name matches the specified pattern using the `Like` operator. If a match is found, the file is copied to the destination folder using the `CopyFile` method of the `FileSystemObject`.

After running the code, a message box will display the number of found files. The matching files will be copied to the "Found Files" subfolder within the destination folder.

[#6]

This works wonderfully for finding one specific file, thank you!

It's slightly different than what I'm attempting but it might work with one change.

Is it possible to set the fileNamePattern to read from a table, an array, or to pull files by matching the first 5 digits to a list in excel?

When I get a delivery it comes with a list of file names, but only that first 5 digit number of each file name. I'd like to be able to take that list, paste it into excel every time I get a delivery, and have it copy the related files to the destination folder automatically.

[#7]

@AnthonyDavisSF 

Sub test()

Dim r%, i%

    Dim arr

With Worksheets("Sheet1")

        r = .Cells(.Rows.Count, 1).End(xlUp).Row

        arr = .Range("a1:e" & r)

        For i = 2 To UBound(arr)

   SearchAndCopyFiles arr(i,4)

   rem column 4 contains the fileNamePattern

  Next

End With

End Sub

Sub SearchAndCopyFiles(fileNamePattern)

    Dim fso As Object ' FileSystemObject

    Dim sourceFolder As String

    Dim destinationFolder As String

    Dim fileNamePattern As String

    Dim file As Object ' File

    Dim foundFilesCount As Integer

    ' Set the source folder path

    sourceFolder = "C:\Path\To\Source\Folder"

    ' Set the destination folder path

    destinationFolder = "C:\Path\To\Destination\Folder\Found Files"

    ' Set the partial file name pattern

rem fileNamePattern = "*20448*"

    ' Create a FileSystemObject

    Set fso = CreateObject("Scripting.FileSystemObject")

    ' Check if the source folder exists

    If Not fso.FolderExists(sourceFolder) Then

        MsgBox "Source folder does not exist."

        Exit Sub

    End If

    ' Check if the destination folder exists and create it if not

    If Not fso.FolderExists(destinationFolder) Then

        On Error Resume Next

        fso.CreateFolder destinationFolder

        On Error GoTo 0

        ' Check if the creation was successful

        If Not fso.FolderExists(destinationFolder) Then

            MsgBox "Unable to create the destination folder."

            Exit Sub

        End If

    End If

    ' Loop through all files in the source folder

    For Each file In fso.GetFolder(sourceFolder).Files

        ' Check if the file name matches the pattern

        If fso.GetFileName(file.Path) Like fileNamePattern Then

            ' Copy the file to the destination folder

            fso.CopyFile file.Path, destinationFolder & "\" & fso.GetFileName(file.Path)

            foundFilesCount = foundFilesCount + 1

        End If

    Next file

    MsgBox "Found files: " & foundFilesCount

End Sub