我在A列中有文件名要更改为B列中的值。扩展名在重命名时不应更改。
Sub rename
Dim Source As Range
Dim OldFile As String
Dim NewFile As String
Set Source = Cells(1, 1).CurrentRegion
For Row = 1 To Source.Rows.Count
OldFile = ActiveSheet.Cells(Row, 1)
NewFile = ActiveSheet.Cells(Row, 2)
' rename files
Name OldFile As Newfile
Next
end sub
答案 0 :(得分:0)
对您的代码进行此修改将剥离NewFile
的所有扩展名(如果扩展名不超过5个字符):
Sub Rename()
Dim Source As Range
Dim OldFile As String
Dim NewFile As String
Dim Row As Long
Set Source = Cells(1, 1).CurrentRegion
For Row = 1 To Source.Rows.Count
OldFile = ActiveSheet.Cells(Row, 1)
NewFile = ActiveSheet.Cells(Row, 2)
'see if NewFile contains an extension
If InStr(Right(NewFile, 6), ".") > 0 Then
'if so, strip it off
NewFile = Left(NewFile, InStrRev(NewFile, ".") - 1)
End If
'append extension
NewFile = NewFile & Mid(OldFile, InStrRev(OldFile, "."))
' rename files
Name OldFile As NewFile
Next
End Sub