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

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

我的情况相当特殊,我想了解一些情况。我没有编程背景,所以我想我会转向这里。

我有一堆文件夹。在这些文件夹中的每一个里面是另一个文件夹。该文件夹中有一些文件。

这些文件以一些乱码字母和数字命名,然后是字符“-”(无引号),最后是我想用作新文件的名称后缀.

我想使用该顶级文件夹名称并将其作为前缀和上述后缀来为每个新文件名创建 "prefix - suffix"。

我的第一个想法是通过 VBS 来完成此操作,但同样,我不熟悉。有人可以发光或提供脚本吗?假设它不是太麻烦。

我拥有和正在寻找的示例:

这是一个小小的创业(想法),只是为一个文件重命名,所以试试看,告诉我这是不是你期望的重命名(对于一个文件)?

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

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