Find file in folder using cell value, then rename to another cell value

Question

I have PDF files in a folder (say, C:\MyFiles").

On Excel I have a list of numbers in column D which correlate partially to the filenames in that folder (the numbers on the cells on column D can be anywhere in the filenames).
On column E, I have new filenames I want to give to the files having the numbers on column D.

I need to:

• Read the value in column D, and look for a file in the specified folder that has that value in any part of the filename. For example,
  if D1 has the number "1234567", I want to find the file with the name (xxxx1234567xxxxxxxxx), "x" being any other number or letter.
• If a matching file is found, rename it to the value in column E, while also keeping the file extension (.pdf).
• Read through the whole column until the end of list, then stop.
• If no matching file for a specific value in column D, skip and go to the next one.

This code shows no error, but it doesn't change any names.

Sub FindReplace()

Dim objFolder As Object
Dim objFile As Object
Dim i As Long
Set objFolder = CreateObject("Scripting.FileSystemObject").GetFolder("C:\MyFiles")
            
i = 1
            
For Each objFile In objFolder.Files
    If objFile.Name Like "*" & Cells(i, "D").Value & "*" Then
        objFile.Name = Cells(i, "E").Value & ".PDF"
    End If
                
    i = i + 1: If i > Cells(Rows.Count, "D").End(xlUp).Row Then Exit For
                    
Next objFile
    
End Sub

I would also like the macro to make the user select a folder of their choosing, rather than having to use the same folder every time, but that is optional. What is needed right now is the file renaming.

Answer 1

It's a little easier I think to use Dir() to find partial matches:

Sub FindReplace()

    Dim fPath As String, f, c As Range, ws As Worksheet
    Dim i As Long
    
    fPath = GetFolderPath("Select a folder for file renaming")
    If Len(fPath) = 0 Then Exit Sub 'no folder selected
    
    Set ws = ActiveSheet 'or some specific sheet
    For Each c In ws.Range("D2:D" & ws.Cells(Rows.Count, "D").End(xlUp).row).Cells
        If Len(c.Value) > 0 Then
            f = Dir(fPath & "*" & c.Value & "*.pdf", vbNormal)
            If Len(f) > 0 Then 'found a match?
                Name fPath & f As fPath & c.Offset(0, 1).Value & ".pdf"
            End If
        End If
    Next
       
End Sub

'get a folder from the user - returns empty string if no selection
Function GetFolderPath(msg As String) As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = msg
        If .Show = -1 Then GetFolderPath = .SelectedItems.Item(1) & "\"
    End With
End Function