批量修改文件前缀的VBS源码

On Error Resume Next
Dim prefix, DirTotal, TimeSpend, FileTotal, fso, curPath, sPath

Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0
Const OPTIONS = 0

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(MY_COMPUTER)
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path

Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "选择你要处理的文件夹:", OPTIONS, strPath)
If objFolder Is Nothing Then
        MsgBox "您没有选择任何有效目录!"
        wscript.quit
Else
        Set objFolderItem = objFolder.Self
        sPath = objFolderItem.Path
        curPath = sPath

        FileTotal = 0
        DirTotal = 0

        prefix = LCase(InputBox("请输入你要添加的文件前缀:", "批量文件添加前缀", "create_"))

        TimeSpend = Timer

        myFind curPath, prefix

        TimeSpend = Round(Timer - TimeSpend, 2)

        MsgBox "处理完成！共耗费时间：" & TimeSpend


        Set fso = Nothing
        wscript.quit
End If

Sub myFind(ByVal thePath, ByVal prefix)

        Dim fso, myFolder, myFile, curFolder
        Set fso = wscript.CreateObject("scripting.filesystemobject")
        Set curFolders = fso.getfolder(thePath)
        DirTotal = DirTotal + 1
       
        If curFolders.Files.Count > 0 Then
                For Each myFile In curFolders.Files
                        if left(myFile.Name,len(prefix))<>prefix then
                         myFile.Move FormatPath(thePath) & "\" & prefix & myFile.Name
                         FileTotal = FileTotal + 1
      end if
                Next
        End If

        If curFolders.subfolders.Count > 0 Then
                For Each myFolder In curFolders.subfolders
                        myFind FormatPath(thePath) & "\" & myFolder.Name, prefix
                Next
        End If

End Sub

Function FormatPath(ByVal thePath)

        thePath = Trim(thePath)
        FormatPath = thePath
        If Right(thePath, 1) = "\" Then FormatPath = Mid(thePath, 1, Len(thePath) - 1)

End Function


将以上代码存为 addpre.vbs 就可以运行使用了。