想要使用excel 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. ie 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

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.

Answer 3

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)