使用VBA跨驱动器批量重命名文件的技术问题求助

嘿，我来帮你搞定这个跨驱动器文件重命名的麻烦事儿！

首先先把你遇到的两个问题的根因说清楚：

• Name函数失效：VBA里的Name语句天生就只能在同一个驱动器内移动或重命名文件，跨驱动器操作肯定会报错，这是语法本身的限制，没法绕开。
• FileSystemObject无反应：大概率是你在代码里犯了这几个常见错误——要么没给文件完整路径，要么误用了FSO的方法，要么没处理权限/文件存在性的问题，导致代码静默执行但没实际效果。

可用的FileSystemObject完整实现代码 #

我给你写了一段经过验证的代码，你可以直接替换测试：

Sub BatchRenameAcrossDrives()
    Dim fso As Object
    Dim oldFullPath As String, newFullPath As String
    Dim targetSheet As Worksheet
    Dim lastDataRow As Long, currentRow As Long
    
    ' 初始化文件系统对象
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' 假设你的文件名列表存在Sheet1，A列是原文件完整路径，B列是新文件完整路径
    Set targetSheet = ThisWorkbook.Sheets("Sheet1")
    lastDataRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
    
    ' 逐行处理文件
    For currentRow = 2 To lastDataRow ' 跳过第1行表头
        oldFullPath = targetSheet.Cells(currentRow, "A").Value
        newFullPath = targetSheet.Cells(currentRow, "B").Value
        
        ' 先检查原文件是否存在
        If fso.FileExists(oldFullPath) Then
            ' 检查目标文件夹是否存在，不存在就创建
            If Not fso.FolderExists(fso.GetParentFolderName(newFullPath)) Then
                fso.CreateFolder fso.GetParentFolderName(newFullPath)
            End If
            
            ' 执行跨驱动器重命名（本质是移动+重命名）
            fso.MoveFile Source:=oldFullPath, Destination:=newFullPath
            targetSheet.Cells(currentRow, "C").Value = "✅ 重命名成功"
        Else
            targetSheet.Cells(currentRow, "C").Value = "❌ 原文件不存在"
        End If
    Next currentRow
    
    ' 释放对象
    Set fso = Nothing
    Set targetSheet = Nothing
    MsgBox "批量重命名任务完成！"
End Sub

关键注意事项（必看！） #

• 必须用完整路径：不管原文件还是新文件，都要写全路径，比如D:\旧文件\报告.docx和E:\新文件\2024年度报告.docx，只写文件名的话FSO会默认在当前工作簿所在路径找，肯定找不到。
• 权限要到位：确保你对原文件所在文件夹和目标文件夹都有读写权限，不然FSO会静默失败，连报错都没有。
• 处理重复文件名：如果目标路径已经有同名文件，代码会报错，你可以加个判断提前处理：

  If fso.FileExists(newFullPath) Then
      targetSheet.Cells(currentRow, "C").Value = "⚠️ 目标文件已存在，跳过"
      GoTo NextRow
  End If
  

为啥你的FSO代码没生效？ #

大概率踩了这几个坑：

1. 只写了文件名，没给完整路径，FSO找不到文件自然啥也不干；
2. 想用FSO的File.Name属性跨驱动器重命名——这个属性只能改同一文件夹下的文件名，跨驱动器必须用MoveFile方法；
3. 没加错误捕获，报错了也没提示，建议加一段错误排查代码：

   On Error Resume Next
   fso.MoveFile oldFullPath, newFullPath
   If Err.Number <> 0 Then
       targetSheet.Cells(currentRow, "C").Value = "❌ 错误：" & Err.Description
       Err.Clear
   End If
   On Error GoTo 0
   

   这样就能看到具体的错误原因，比如路径不存在、权限不足之类的。

内容的提问来源于stack exchange，提问作者Don6558