CODEWITHSUNDEEP
vbscriptrenaming
Kr3pt
Kr3pt

Reputation: 13

Rename files using foldername as prefix and part of current filename VBS

I have a fairly unique situation and I'd like some insight. I have no programming background so I figured I'd turn here.

I have a bunch of folders. Inside each of those folders is another folder. Inside that folder is a few files.

These files are named with some gibberish letters and numbers, then the characters "-" (no quotes), and finally the name i'd like to use as the new suffix.

I would like to take that top tier foldername and make it the prefix and the above mentioned suffix to create "prefix - suffix" for each new filename.

My first thought was to do this via VBS, but again, I'm unfamiliar. Can someone shine some light or provide a script? Assuming its not too much of a hassle.

An example of what I have and what I'm looking for:

enter image description here

Upvotes: 1

Views: 1824

Answers (2)

Hackoo
Hackoo

Reputation: 18857

Give a try for this vbscript :

Option Explicit
Dim File,MyRootFolder,RootFolder,Prefix,Suffix
MyRootFolder = Browse4Folder
Call Scan4File(MyRootFolder)
MsgBox "Script Done !",VbInformation,"Script Done !"
'**************************************************************************
Function GetTheParent(DriveSpec)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    GetTheParent = fso.GetParentFolderName(Drivespec)
End Function
'**************************************************************************
Function StripPathFolder(Path)   
    Dim arrStr : arrStr = Split(Path,"\")   
    StripPathFolder = arrStr(UBound(arrStr))   
End Function   
'**************************************************************************
Function StripPathFile(Path)   
    Dim arrStr : arrStr = Split(Path,"-")   
    StripPathFile = Replace(arrStr(UBound(arrStr)),"_","-")
End Function   
'**************************************************************************
Function Browse4Folder()
    Dim objShell,objFolder,Message
    Message = "Please select a folder in order to scan into it and its subfolders to rename files"
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0,Message,0,0)
    If objFolder Is Nothing Then
        Wscript.Quit
    End If
    Browse4Folder = objFolder.self.path
End Function
'**********************************************************************************************
Function Scan4File(Folder)
    Dim fso,objFolder,arrSubfolders,File,SubFolder,NewFileName
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fso.GetFolder(Folder)
    Set arrSubfolders = objFolder.SubFolders
    For Each File in objFolder.Files
        RootFolder = GetTheParent(GetTheParent(File)) 
        Prefix = StripPathFolder(RootFolder) 
        Suffix = StripPathFile(File)
        NewFileName = Prefix & Suffix
'MsgBox Prefix,Vbinformation,Prefix
'MsgBox Suffix,Vbinformation,Suffix
'MsgBox "New File Name ==> " & NewFileName,Vbinformation,Prefix & Suffix
        Call RenameFile(File,NewFileName)
    Next
    For Each SubFolder in objFolder.SubFolders
        Call Scan4File(SubFolder)
    Next
End Function
'**********************************************************************
Sub RenameFile(File1,File2)
    Dim Ws,Command,Execution
    Set Ws = CreateObject("WScript.Shell")
    Command = "Cmd /c Ren "& DblQuote(File1) &" "& DblQuote(File2) &""
    Execution = Ws.Run(Command,0,False)
End Sub
'**********************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************

Upvotes: 1

Hackoo
Hackoo

Reputation: 18857

This is a little startup (idea), just to rename for one file, so give a try and tell me is this as you expected to rename like this or not (for one file) ?

Option Explicit
Dim File,RootFolder,Prefix,Suffix
File = "aerzipjfdesh785zafokvsshjdj_-_File1"
RootFolder = GetTheParent("c:\FolderA\Folder_A")
Prefix = StripPathFolder(RootFolder) 
Suffix = StripPathFile(File)
MsgBox Prefix,Vbinformation,Prefix
MsgBox Suffix,Vbinformation,Suffix
MsgBox "New File Name ==> " & Prefix & Suffix,Vbinformation,Prefix & Suffix
'**************************************************************************
Function GetTheParent(DriveSpec)
   Dim fso
   Set fso = CreateObject("Scripting.FileSystemObject")
   GetTheParent = fso.GetParentFolderName(Drivespec)
End Function
'**************************************************************************
Function StripPathFolder(Path)   
    Dim arrStr : arrStr = Split(Path,"\")   
    StripPathFolder = arrStr(UBound(arrStr))   
End Function   
'**************************************************************************
Function StripPathFile(Path)   
    Dim arrStr : arrStr = Split(Path,"-")   
    StripPathFile = Replace(arrStr(UBound(arrStr)),"_","-")
End Function   
'**************************************************************************

Upvotes: 0

Related Questions