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

Question

非常感谢你在这方面的帮助。

我需要执行以下操作：我在一个文件夹（例如，C:\MyFiles"）中有一些文件，里面有一堆 PDF。在 Excel 上，我在列中有一个数字列表D 与该文件夹中的文件名部分相关（即 D 列上的单元格上的数字可以在文件名中的任何位置）。在 E 列上，我有新的文件名，我想为具有 D 列上的数字的文件提供新的文件名。

基本上，我需要一个宏可以：

读取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

理想情况下，我还希望宏使用户 select 成为他们选择的文件夹，而不是每次都必须使用相同的文件夹，但这是可选的。现在需要的是文件重命名。

提前谢谢大家！

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

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

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

excel

filenames

vba