2015-04-22 180 views
1

我有一个相当独特的情况,我希望有一些见解。我没有编程背景,所以我想我会转到这里。使用文件夹名称作为前缀和当前文件名的一部分重命名文件VBS

我有一堆文件夹。每个文件夹内都有另一个文件夹。该文件夹内有几个文件。

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

我想取顶层文件夹名称,并将其作为前缀和上述后缀为每个新文件名创建“前缀 - 后缀”。

我的第一个想法是通过VBS做到这一点,但我再次不熟悉。有人可以照亮一些光线或提供剧本吗?假设它没有太多的麻烦。

的一个例子,我有什么,什么我在寻找:

enter image description here

+0

VBScript是不是VB.NET通过公平保证金相同。 – Plutonix

+0

这是一个建议的标签。我道歉。感谢您的意见。 – Kr3pt

回答

0

试用一下这个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 
'********************************************************************** 
+0

这个脚本非常棒!谢谢。 虽然它确实将所有其他下划线改为连字符。但这并不重要。谢谢您的帮助! – Kr3pt

+0

@ Kr3pt发生这种情况也许你两次运行脚本:) 如果你喜欢它,你也可以upvote这个答案!阅读本文http://stackoverflow.com/tour – Hackoo

+0

我在上午4点运行它,所以我很可能已经做了两次; P ...我试着为你加油,但不幸的是我没有15的声望我能做的最好的事情就是成为一个解决方案。 – Kr3pt

0

这是一个小的启动(想法),只是重命名一个文件,所以给一个尝试,并告诉我这是否如你所期望的那样重命名或不重写?

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

消息框显示正确的消息。但是没有重命名发生。 我改变的唯一的事情是“RootFolder”路径。我需要改变什么吗? RootFolder确实包含文件名“aerzipjfdesh785zafokvsshjdj _-_ File1” – Kr3pt

+0

@ Kr3pt是的这就是我的意思只是显示一个消息框,只是为了测试! – Hackoo