使用文件夾名稱作爲前綴和當前文件名的一部分重命名文件VBS

Question

我有一個相當獨特的情況，我希望有一些見解。我沒有編程背景，所以我想我會轉到這裏。

我有一堆文件夾。每個文件夾內都有另一個文件夾。該文件夾內有幾個文件。

這些文件被命名爲一些亂碼字母和數字，然後是字符「-」（不含引號），最後是我想用作新後綴的名稱。

我想取頂層文件夾名稱，並將其作爲前綴和上述後綴爲每個新文件名創建「前綴 - 後綴」。

我的第一個想法是通過VBS做到這一點，但我再次不熟悉。有人可以照亮一些光線或提供劇本嗎？假設它沒有太多的麻煩。

的一個例子，我有什麼，什麼我在尋找：

Answer 1

試用一下這個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 
'********************************************************************** 

Answer 2

這是一個小的啓動（想法），只是重命名一個文件，所以給一個嘗試，並告訴我這是否如你所期望的那樣重命名或不重寫？

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