Delete last 12 characters of file names in external hard drive folder.

S.H.A.D.O.

Well-known Member
Joined
Sep 6, 2005
Messages
1,915
Good afternoon,

I have an external hard drive with a folder named MP4. Within that folder there are about 500 MP4 files. What I would like to do is to delete the last twelve characters from EACH of the filenames. The 12 characters are firstly a SPACE, then followed by [abcwdefgh] for example including the brackets, the 12 characters are IDENTICAL at the end of EACH file though. Is there an easy way to do this please without the need to edit every single one?.

Thanks in advance.
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Hi

For instance (untested coding ==> use a backup):

Code:
Sub RenameFiles()
    
    sPath = "...\MP4\"
    fn = Dir(sPath & "*.*")
    Do While fn <> ""
    
        sCurrentFile = fn
    
        sOldFullFilename = sPath & fn
        
        sNewFilename = sCurrentFile
        Mid(sNewFilename, CreateObject("scripting.filesystemobject").GetBaseName(sOldFullFilename) - 11, 12) = ""
        sNewFullFilename = sPath & sNewFilename
        
        Name sOldFullFilename As sNewFullFilename
        
        fn = Dir
    Loop
End Sub
 
Upvote 0
Thanks for the reply wigi,

Unfortunately it falls over on the line...

Code:
        Mid(sNewFilename, CreateObject("scripting.filesystemobject").GetBaseName(sOldFullFilename) - 11, 12) = ""
 
Upvote 0
I suggest using Total Commander (free download unregistered).


Open TC, select the files to change in the folder on the external hard drive then press Ctrl-M or click on ("Rename in group" or sth like that, I have Hungarian version) at the end part of the menu bar. Go to pane called "Find and replace" and write in the Find box the characters you want to delete, leaving the ChangeReplace box empty. In the table of "Old name" "New name" check that the new names are what you want. If yes, Start.
 
Upvote 0
Right, something was missing there. Here's tested code:

Code:
Sub RenameFiles()    
    sPath = "C:\TestRuns\"
    fn = Dir(sPath & "*.*")
    Do While fn <> ""
    
        sOldFullFilename = sPath & fn
        
        sNewFullFilename = sPath & WorksheetFunction.Replace(fn, Len(CreateObject("scripting.filesystemobject").GetBaseName(sOldFullFilename)) - 11, 12, "")
        
        Name sOldFullFilename As sNewFullFilename
        
        fn = Dir
    Loop
End Sub
 
Upvote 0
Thanks again wigi,

But unfortunately it falls over on line...

Code:
        sNewFullFilename = sPath & WorksheetFunction.Replace(fn, Len(CreateObject("scripting.filesystemobject").GetBaseName(sOldFullFilename)) - 11, 12, "")

...with the error...

Run-time error '1004'
Unable to get the Replace property of the WorksheetFunction class

I have tried running it a couple of times as well.
I obviously don't want to end up with a duplicate file without the last 10 characters as well as the original file.

Thanks again in advance.
 
Upvote 0
Try this one..

It basically 'moves' the file onto itself with the new name..

Code:
Private Sub CommandButton1_Click()
    Dim x, fldr As FileDialog, SelFold As String, i As Long

    'User Selects desired Folder that contains the MP4 files
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder with MP4 Files"
        If .Show <> -1 Then Exit Sub
        SelFold = .SelectedItems(1)
    End With

    'All .MP4 files in Selected FolderPath including Sub folders are put into an array
    x = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & SelFold & "\*.MP4"" /s/b").stdout.readall, vbCrLf)

    'Loop through that array
    For i = LBound(x) To UBound(x) - 1
        CreateObject("scripting.filesystemobject").MoveFile x(i), Left(Split(x(i), ".")(0), Len(x(i)) - (Len(Split(x(i), ".")(1)) + 13)) & "." & Split(x(i), ".")(1)
    Next i
End Sub
 
Upvote 0
Hello

You are sure that you change the path before running the code?
If yes, please try with 1 file in the directory. If successful, move on to a different file.
Once you encounter a file that gives an error, give me the name of the file and I will change my code so that it works.
In any case, in my limited testing, it works fine here.

What version of Excel do you use?
 
Upvote 0
Thanks again wigi,

This is the code I am using...

Code:
Sub RenameFiles9()
    Dim sOldFullFilename As String
    Dim sNewFullFilename As String
'    Dim sPath As String
    
    sPath = "F:\MP4\"
    fn = Dir(sPath & "*.*")
    Do While fn <> ""
    
        sOldFullFilename = sPath & fn
        
        sNewFullFilename = sPath & WorksheetFunction.Replace(fn, _
            Len(CreateObject("scripting.filesystemobject").GetBaseName(sOldFullFilename)) - 11, 12, "")
        
        Name sOldFullFilename As sNewFullFilename
        
        fn = Dir
    Loop
    
End Sub

...and I am using Excel 2007.

Thanks again wigi.
 
Upvote 0
Please give me a filename with which the code gives an error.
 
Upvote 0

Forum statistics

Threads
1,214,584
Messages
6,120,384
Members
448,956
Latest member
JPav

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top