使用foldername作为前缀和当前文件名VBS的一部分重命名文件

Question

我有一个相当独特的情况，我想要一些见解。我没有编程背景所以我想我会转到这里。

我有一堆文件夹。每个文件夹里面都有另一个文件夹。在该文件夹中有几个文件。

这些文件以一些乱码字母和数字命名，然后是字符“ - ”（没有引号），最后是我想用作新后缀的名称。

我想采用顶级foldername并将其作为前缀和上面提到的后缀，为每个新文件名创建“prefix - suffix”。

我的第一个想法是通过VBS做到这一点，但同样，我不熟悉。有人可以发光或提供脚本吗？假设它不是太麻烦。

我所拥有的和我正在寻找的一个例子：

Answer 1

这是一个小小的创业公司（想法），只是为一个文件重命名，所以试一试，告诉我这是你想要这样重命名或不重命名（对于一个文件）？

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   
'**************************************************************************

Answer 2

试试这个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
'**********************************************************************