使用单元格值在文件夹中查找文件，然后重命名为另一个单元格值

Question

我有一个PDF文件文件夹(比如C:MyFiles")。

在Excel中，我有一个列D中的数字列表，其中部分与该文件夹中的文件名相关(列D上单元格上的数字可以在文件名中的任何地方)。
在E列中，我要为d列中数字的文件设置新文件名

I need to:

• 读取D列中的值，在指定的目录中查找文件在文件名的任何部分中具有该值的文件夹。例如，
  如果D1的数字为"1234567"，我要查找的文件为名称(xxxx1234567xxxxxxxxx)， "x"是任何其他数字或字母。
• 如果找到匹配的文件，将其重命名为E列中的值;同时保留文件扩展名(.pdf)。
• 读取整个列，直到列表结束，然后停止。
• 如果D列中没有匹配的文件，则跳过并进入下一个。

这段代码没有显示错误，但是它没有改变任何名称。

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

我还希望宏让用户选择他们选择的文件夹，而不是每次都使用相同的文件夹，但这是可选的。现在需要的是文件重命名。

Answer 1

我认为使用Dir()查找部分匹配更容易:

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