Sub RenameFiles() Dim orgPath As String, newPath As String, renameSheet As Worksheet Dim fileCell As Range, renameCell As Range, newName As String '设置文件夹路径和工作表 orgPath = "C:\Users\DELL\Desktop\ZTE FILES\ORG_FILES\" newPath = "C:\Users\DELL\Desktop\ZTE FILES\NEW_FILES\" Set renameSheet = ThisWorkbook.Sheets("ZTE RENAME") '清空工作簿C2:C列 renameSheet.Range("C2:C" & renameSheet.Cells(Rows.Count, "C").End(xlUp).Row).ClearContents '查找文件夹里的所有文件名 For Each fileCell In renameSheet.Range("C2:C" & renameSheet.Cells(Rows.Count, "C").End(xlUp).Row) If fileCell.Value <> "" Then fileCell.Value = Dir(orgPath & fileCell.Value) End If Next fileCell '将文件名按文件夹排序放入工作表C2:C列 renameSheet.Range("C2:C" & renameSheet.Cells(Rows.Count, "C").End(xlUp).Row).Sort key1:=renameSheet.Range("C2"), order1:=xlAscending, Header:=xlNo '复制所有文件到新文件夹 FileCopy orgPath & "*", newPath '重命名文件 For Each renameCell In renameSheet.Range("C2:C" & renameSheet.Cells(Rows.Count, "C").End(xlUp).Row) If renameCell.Value <> "" Then newName = renameSheet.Range("H" & renameCell.Row).Value Name newPath & renameCell.Value As newPath & newName End If Next renameCell End Sub

这是一段 VBA 代码，用于批量重命名文件。首先，代码设置了两个文件夹路径，一个是原始文件夹路径，一个是新文件夹路径。然后，代码清空了工作表中的 C 列。接下来，代码在原始文件夹路径中查找所有文件名，并将其放入工作表的 C 列中。然后，代码按文件夹排序工作表中的文件名。接着，代码将所有文件复制到新文件夹路径中。最后，代码遍历工作表中的文件名，并根据工作表中 H 列的值将其重命名为新名称。

相关问题

Sub RenameFiles() '设置文件路径和文件名 Dim orgPath As String Dim newPath As String Dim orgFile As String Dim newFile As String orgPath = "C:\Users\DELL\Desktop\ZTE FILES\ORG_FILES\" newPath = "C:\Users\DELL\Desktop\ZTE FILES\NEW_FILES\" '打开工作簿和工作表 Dim wb As Workbook Set wb = ThisWorkbook Dim ws As Worksheet Set ws = wb.Sheets("ZTE FILES") '查找文件夹中的所有文件名 orgFile = Dir(orgPath & "*.*") Dim i As Integer i = 2 '将文件名写入工作表 Do While Len(orgFile) > 0 ws.Range("C" & i).Value = orgFile i = i + 1 orgFile = Dir Loop '复制所有文件到新文件夹 Dim sourceFile As String Dim destFile As String For i = 2 To ws.Range("C" & Rows.Count).End(xlUp).Row sourceFile = orgPath & ws.Range("C" & i).Value destFile = newPath & ws.Range("H" & i).Value FileCopy sourceFile, destFile Next i '重命名新文件夹中的文件 For i = 2 To ws.Range("C" & Rows.Count).End(xlUp).Row orgFile = newPath & ws.Range("C" & i).Value newFile = newPath & ws.Range("H" & i).Value Name orgFile As newFile Next i End Sub Name orgFile As newFile报错文件不存在，运行的结果却正常

这可能是因为程序没有检查原始文件和目标文件是否存在。如果目标文件已经存在，那么 `Name` 命令将会失败并报错。

你可以在重命名文件之前添加以下代码片段来检查文件是否存在：

'重命名新文件夹中的文件
For i = 2 To ws.Range("C" & Rows.Count).End(xlUp).Row
orgFile = newPath & ws.Range("C" & i).Value
newFile = newPath & ws.Range("H" & i).Value
If Dir(orgFile) <> "" Then
If Dir(newFile) = "" Then
Name orgFile As newFile
Else
MsgBox "文件 " & newFile & " 已存在！"
End If
Else
MsgBox "文件 " & orgFile & " 不存在！"
End If
Next i

这样，程序将会检查每个要重命名的文件是否存在，并且如果目标文件已经存在，将会弹出一个提示框来告知用户。

希望这能帮到你！

FileCopy orgPath & "*", newPath 这里报错，请重写

如果 FileCopy orgPath & "*", newPath 报错，可以尝试使用 Dir 函数来获取原始文件夹路径中所有的文件名，然后逐个将其复制到新文件夹路径中。修改后的代码如下：

Sub RenameFiles()
    Dim orgPath As String, newPath As String, renameSheet As Worksheet
    Dim fileCell As Range, renameCell As Range, newName As String
    Dim fileName As String, fileExtension As String

    '设置文件夹路径和工作表
    orgPath = "C:\Users\DELL\Desktop\ZTE FILES\ORG_FILES\"
    newPath = "C:\Users\DELL\Desktop\ZTE FILES\NEW_FILES\"
    Set renameSheet = ThisWorkbook.Sheets("ZTE RENAME")

    '清空工作簿C2:C列
    renameSheet.Range("C2:C" & renameSheet.Cells(Rows.Count, "C").End(xlUp).Row).ClearContents

    '查找文件夹里的所有文件名
    fileName = Dir(orgPath & "*")
    Do While fileName <> ""
        '获取文件名和文件扩展名
        fileExtension = Right(fileName, Len(fileName) - InStrRev(fileName, "."))
        fileName = Left(fileName, InStrRev(fileName, ".") - 1)

        '将文件名放入工作表的 C 列中
        Set fileCell = renameSheet.Range("C:C").Find(fileName, LookIn:=xlValues)
        If Not fileCell Is Nothing Then
            fileCell.Value = fileName & "." & fileExtension
        End If

        '复制文件到新文件夹路径中
        FileCopy orgPath & fileName & "." & fileExtension, newPath & fileName & "." & fileExtension

        '查找下一个文件名
        fileName = Dir
    Loop

    '将文件名按文件夹排序放入工作表C2:C列
    renameSheet.Range("C2:C" & renameSheet.Cells(Rows.Count, "C").End(xlUp).Row).Sort key1:=renameSheet.Range("C2"), order1:=xlAscending, Header:=xlNo

    '重命名文件
    For Each renameCell In renameSheet.Range("C2:C" & renameSheet.Cells(Rows.Count, "C").End(xlUp).Row)
        If renameCell.Value <> "" Then
            newName = renameSheet.Range("H" & renameCell.Row).Value
            Name newPath & renameCell.Value As newPath & newName
        End If
    Next renameCell
End Sub

修改后的代码中使用了 Do While 循环和 Dir 函数来实现文件的复制，同时也对获取文件名和文件扩展名的方式进行了修改。