VBA - Bulk Renaming of Files

[unknownymous]

Hi Gurus,

I'm currently working on a macro but can't find any that suits the process I have. I need to rename hundreds of files in word, excel and pdf format.

Example Filenames:

HOP12345 FileOne.doc
9876ABCD FileTwo 1234.xls
A1RBL234 Data 000.pdf

What I need is the macro that will rename the files by batch in a single folder. Basically, I just need to get the first 8 letter/word (mixed) to be the filename of each file.


Any help will be much appreciated.

 

[AlphaFrog]

Maybe something like this...

[COLOR=darkblue]Sub[/COLOR] Renamer()
    [COLOR=darkblue]Dim[/COLOR] strPath [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], strFile [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], counter [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [B]strPath = "C:\Test\"    [COLOR=green]'Change the path to suit[/COLOR][/B]
    strFile = Dir(strPath & "*.*")
    [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]While[/COLOR] strFile <> ""
        [COLOR=darkblue]If[/COLOR] Len(strFile) > 12 [COLOR=darkblue]Then[/COLOR]
            Name strPath & strFile [COLOR=darkblue]As[/COLOR] strPath & Left(strFile, 8) & Mid(strFile, InStrRev(strFile, "."))
            counter = counter + 1
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        strFile = Dir
    [COLOR=darkblue]Loop[/COLOR]
    MsgBox counter & " files renamed.", vbInformation, "File Renaming Complete"
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[unknownymous]

It works! Appreciate your help AlphaFrog.

By the way, how can you tweak the code if if going to get the mid string?

Examples:
0001_HOP12345_FileOne.doc
0002TH_9876ABCD_FileTwo.xls
NO0002_A1RBL234_Data000.pdf

 

[AlphaFrog]

Try this...

Name strPath & strFile As strPath & Split(strFile, "_")(1) & Mid(strFile, InStrRev(strFile, "."))

 

[unknownymous]

Works like magic! Thank you