想用excel vba在文件扩展名之前添加后缀

我有下面的代码,将列出的后缀和前缀添加到“B”列中列出的文件名称。 但是问题是,文件扩展名后面加了后缀。 我想在文件名的末尾添加文本。 即如果文件名是test.txt,我想,1test9.txt但代码重命名为1test.txt9

Sub Add_Pre_Suf() Dim Pre, Suf As String Dim r As Range Pre = Range("C2").Value Suf = Range("D2").Value Range("B2").Select 'Range(Selection, Selection.End(xlDown)).Select Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).Select With Selection For Each r In Selection r.Value = Pre & r.Value & Suf Next End With RenameFiles End Sub 

这应该很好地做这个工作:

 Sub Add_Pre_Suf() ' 21 Mar 2017 Dim Pre As String, Suf As String Dim Splt() As String Dim Ext As String Dim R As Long, Rend As Long Pre = Range("C2").Value Suf = Range("D2").Value Rend = Cells(Rows.Count, "B").End(xlUp).Row For R = 2 To Rend With Cells(R, 2) ' 2 = "B" If Len(.Value) Then Splt = Split(.Value, ".") Ext = Splt(UBound(Splt)) ReDim Preserve Splt(UBound(Splt) - 1) .Value = Pre & " " & Trim(Join(Splt, ".")) & " " & Suf & "." & Ext End If End With Next R RenameFiles End Sub 

当你调用这段代码时要小心一点,因为它没有指定工作表,所以在ActiveSheet上工作。 我不会先调用“RenameFiles”过程,而是先检查名称是否真的是我所期望的。

请注意, Range("C2")可能被称为Cells(2, 3)

你可以使用这个Scripting.FileSystemObject 。 只需添加对Microsoft脚本运行时的引用:

 With New Scripting.FileSystemObject Dim filePath As String filePath = r.Value r.Value = Pre & .GetBaseName(filePath) & Suf & "." & _ .GetExtensionName(filePath) End With 

您看到这种行为的原因是您的列B已经有文件扩展名。 您可以从列中拆分文件扩展名,并在添加文件扩展名之前添加后缀。 你可以改变你的代码来做类似的事情。

 With Selection For Each r In Selection r.Value = Pre & left(r.Value,find(".",r.Value)-1) & Suf & right (r.Value,len(r.Value)-find(".",r.Value)+1) Next End With 

编辑:一个更好的代码将适用于任何数量的字符的扩展。