vba 重命名文件夹中的文件，同时保持扩展名不变
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/41437474/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
提示：将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间：2020-09-12 11:47:47 来源:igfitidea点击:
Renaming files in a folder while keeping extension unchanged
提问by mad2
I have file names in Column A to be changed to the values in Column B. The extension shouldn't change while renaming.
我将 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
回答by YowE3K
This modification to your code will strip off any extensions from NewFile(providing the extension is no longer than 5 characters long):
对您的代码进行的此修改将删除任何扩展名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
