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

Question

我在文件夹中有pdf文件（例如，c：\ myfiles”）。

在excel上，我有一个数字列表，该列中的数字列表与该文件夹中的文件名部分相关联（D列D上的单元格上的数字可以在文件名）。
在E列上，我有新的文件名，我想将其提供给具有列上数字的文件。

我需要：

• 读取D列中的值，并在指定的 在文件名的任何部分中具有该值的文件夹。例如，
  如果D1具有“ 1234567”的数字，我想与 名称（xxxx1234567xxxxxxxx），“ 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