Rename files in folder vba - vba

Question

I have code to find a filename from column A and rename files as in column B in a source folder and then copy to a new folder.
The code is as below.
Sub Rename_Files()
Dim SourcePath, DestPath, Fname, NewFName
SourcePath = "C:\Invoices\"
DestPath = "C:\Invoices\Renamed\"
For i = 1 To 100
Fname = Range("A" & i).Value
NewFName = Range("B" & i).Value
If Not Dir(SourcePath & Fname, vbDirectory) = vbNullString Then
FileCopy SourcePath & Fname, DestPath & NewFName
Else
MsgBox (Fname & " Not Exists in Folder")
End If
Next i
End Sub
The problem is that The filenames in the source directory are long like 'INVOICEDUMP_OFND_4294819_ABC Corp.pdf' and hundreds of like this.
I want to find the file containing 4294819 (from column A) in the name and then replace the name with only 'INV 4294819.pdf' (as mentioned in column B).
Thanks

Answer 1

Unless my DOS skills are extremely rusty, you should be able to use
Sub Rename_Files()
Dim SourcePath As String, DestPath As String, Fname As String, NewFName As String
Dim i As Long
SourcePath = "C:\Invoices\"
DestPath = "C:\Invoices\Renamed\"
For i = 1 To 100
If Not IsEmpty(Range("A" & i).Value) Then
NewFName = Range("B" & i).Value
'Search for the first file containing the string in column A
Fname = Dir(SourcePath & "*" & Range("A" & i).Value & "*")
If Fname <> vbNullString Then
FileCopy SourcePath & Fname, DestPath & NewFName
Else
MsgBox Range("A" & i).Value & " Not Exists in Folder"
End If
End If
Next i
End Sub
This assumes that column A has entries such as 4294819 and that the corresponding entry in column B is something like INV 4294819.pdf.