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

I'd appreacite your help on this one.

I need to do the following: I have some files in a folder (say, C:\MyFiles") with a bunch of PDFs in it. On Excel I have a list of numbers in column D which correlate partially to the filenames in that folder (i.e. 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.

Basically, I need a macro that can:

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 it 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 it can't find a matching file for a specific value in column D, skip and go to the next one.

Currently I have this code, but it's not working properly. It shows no error, but it doesn't change any names either.

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

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

Thank you all in advance!

CodePudding user response：

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