Excel VBA-重命名文件

我有几个文件，我需要更改名称。我有它们的列表，但没有文件扩展名。

只有当列表具有文件扩展名时，代码才能工作。你知道如何解决这个问题吗

    Sub RenameMultipleFiles()
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show = -1 Then
            selectDirectory = .SelectedItems(1)
            dFileList = Dir(selectDirectory & Application.PathSeparator & "*")
        
            Do Until dFileList = ""
                curRow = 0
                On Error Resume Next
                curRow = Application.Match(dFileList, Range("A:A"), 0)
                If curRow > 0 Then
                    Name selectDirectory & Application.PathSeparator & dFileList As _
                    selectDirectory & Application.PathSeparator & Cells(curRow, "B").Value
                End If
        
                dFileList = Dir
            Loop
        End If
    End With
End Sub

这可能会产生你想要的结果。有关您的代码的一些问题，请参见结尾，并在下一步错误恢复时使用

我对您现有的代码做了一些补充，基本上是在将文件名与列A列表匹配时排除文件扩展名，然后将扩展名附加到列B中的名称

现在已对代码进行了编辑，以合并
InStrRev
功能，从而提供延伸长度的动态结果（以循环方式）

我使用了
Left（）、Right（）和Len（）
函数

我在一个包含
Book.xlsx
、
Book.xls
、
Doc.Doc
和
Doc.docx
的测试文件夹中进行了测试。
列A列出了
Book1
和
Doc1
。
B列列出了
New\u Book1
和
New\u Doc1

运行例程后，两个文件都被重命名并保留其文件扩展名

工作表：


在运行例程之前：


运行例程后：



我对您的代码的担心是您在下一次错误恢复时使用了
。原因是如果
curRow
计算结果为错误，则错误将传递
如果curRow>0，则在忽略时传递
。这可能会导致意外或不期望的结果

由于您尚未声明变量（例如，
Dim curRow，只要长
），它们被隐式地定义为type
Variant
，这意味着可以为变量指定任何数据类型。这也可能导致意外的结果，如上所述，您希望为
curRow
变量分配数字，但是当计算错误时，字符串
“error 2042”
将返回到您的变量，然后该变量将尝试通过
If…then
语句进行计算

我注意到，当我运行一些代码测试时，
curRow
返回
Error 2042
，这是
Match（）
函数返回
\N/A
的结果。当当前目标文件与a列中的名称不匹配时会发生这种情况。由于
错误2042>0=FALSE
它应该返回
运行时错误13。类型不匹配
，但由于“下一步继续”时出现错误，它仍尝试重命名文件

这将“更好”地处理而不是忽略（以避免忽略错误而产生意外结果），例如（伪代码）：

正如预期的那样，我们现在在此环境中处理该错误，并允许在需要时仍抛出和/或处理其他错误。
是否有特定原因不包含或不能包含文件扩展名？嗨，Samuel，我有一个列表，其中只列出了需要更新的文件。好的。您可以在列表的每个项目中添加文件扩展名吗？这是让代码正常工作的最简单方法，除非无法做到这一点。大约有2000个文件，这就是我试图找到另一种方法的原因。也许你最好的选择是在每个文件上循环文件，将文件名设置为一个扩展名已删除的变量，并使用“匹配/查找”搜索要更改的文件名a列，然后在找到该列后，使用“B列列表”重命名该文件并重新添加扩展名。我还假设这些文件有多个不同的扩展名？我会
instrev
找到“.”因为我们不知道扩展名有多长。我正在测试Samuel的解决方案，但不适用于我。@Eni，如果您的文件扩展名不是4个字符长，那么它可能无法工作——请考虑西蒙提出的 EntReV。我的答案是一个可能需要针对您的确切用例进行一些调整的解决方案。@Eni我已经编辑了答案，以合并
InStrRev
，并显示一些测试细节和详细说明错误处理。希望有帮助！
 Sub RenameMultipleFiles()
 Dim CharacterCount As Long
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show = -1 Then
            selectDirectory = .SelectedItems(1)
            DFileList = Dir(selectDirectory & Application.PathSeparator & "*")
            Do Until DFileList = ""
                CharacterCount = InStrRev(DFileList, ".")
                curRow = 0
                On Error Resume Next
                curRow = Application.Match(Left(DFileList, CharacterCount - 1), Range("A:A"), 0)
                
                If curRow > 0 Then
                    Name selectDirectory & Application.PathSeparator & DFileList As _
                    selectDirectory & Application.PathSeparator & Cells(curRow, "B").Value & Right(DFileList, Len(DFileList) - CharacterCount + 1)
                End If
        
                DFileList = Dir
            Loop
        End If
    End With
End Sub

If curRow = Error 2042 Then 
    'Do nothing, go to the next iteration
ElseIf curRow > 0 Then
    'Run desired code
End if