Want to add suffix before file name extension with excel vba - vba

Question

I have below code that adds listed suffix and prefix to file names listed in "B" column. But problem is, it adds suffix after file extension. I want to add text at the end of file names.
i.e if file name is test.txt and I want, 1test9.txt but code renames it as 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

Answer 1

You can use the Scripting.FileSystemObject for this. Just add a reference to the Microsoft Scripting Runtime:
With New Scripting.FileSystemObject
Dim filePath As String
filePath = r.Value
r.Value = Pre & .GetBaseName(filePath) & Suf & "." & _
.GetExtensionName(filePath)
End With

Answer 2

This should do the job nicely:-
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
Be a little careful about when you call this code because it doesn't specify the sheet, therefore working on the ActiveSheet. I wouldn't call the 'RenameFiles' procedure without first checking that the names are indeed what I expect them to be.
Note that Range("C2") might be referred to as Cells(2, 3)

Answer 3

The reason you are seeing this behavior is that your Column B already has the file extension. You can split the file extension from the column and add the suffix before adding back the file extension. You can change your code to do something similar.
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
Edit: A better code which will work for extensions which are of any number of characters.