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报错文件不存在,更新 一下,并且运行完成后提醒已完成重命名
时间: 2024-04-05 22:29:49 浏览: 6
好的,你需要将以下代码片段替换掉原来的代码:
'重命名新文件夹中的文件
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
Name orgFile As newFile
End If
Next i
同时,在代码最后添加以下提示语句:
MsgBox "文件重命名已完成!"
这样就可以解决文件不存在的问题,并且在完成时弹出提示框提醒用户。
相关问题
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
这样,程序将会检查每个要重命名的文件是否存在,并且如果目标文件已经存在,将会弹出一个提示框来告知用户。
希望这能帮到你!
打开NEW_FILES文件夹,文件夹里已经有重命名完成的文件了
如果你已经重命名了NEW_FILES文件夹中的文件,并且想要在宏中跳过已经重命名的文件,可以使用VBA中的Dir函数来检查文件是否存在。以下是修改后的代码:
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
newFile = newPath & ws.Range("H" & i).Value
'检查文件是否已经存在,如果不存在则进行复制和重命名操作
If Dir(newFile) = "" Then
FileCopy sourceFile, newFile
Name newFile As newFile
End If
Next i
End Sub
在上述代码中,使用了Dir函数来检查文件是否存在,如果不存在则进行复制和重命名操作。如果文件已经存在,则跳过该文件。