批处理之家's Archiver

老刘1号 发表于 2019-4-23 19:10

VBS实现文件夹/文件补0重命名

隔壁发[url=http://www.bathome.net/thread-52640-1-1.html]去重复[/url],我也来水一贴,
会给目录下的所有文件名/文件夹名中出现的第一个数字补0。
用法:存vbs,要处理的文件/文件夹的父目录拖上去。
[color=Red]文件补0重命名.vbs[/color][code]Rem Code by OldLiu
Option Explicit
Dim fso,Files
Set fso = CreateObject("Scripting.FileSystemObject")
If wsh.Arguments.Count <> 1 Then wsh.Quit
Set Files = fso.GetFolder(wsh.Arguments(0)).Files

Dim regex
Set regex = New RegExp
regex.Global = False
regex.Pattern = "\D*(\d+)"

Rem 得到最大索引
Dim File,lngMaxIndex,strMatch
lngMaxIndex = 0
For Each File In Files
        For Each strMatch In regex.Execute(File.Name)
                If CLng(strMatch.Submatches(0)) > lngMaxIndex Then
                        lngMaxIndex = CLng(strMatch.Submatches(0))
                End If
        Next
Next
If lngMaxIndex = 0 Then wsh.Quit 1

Rem 计算最大补0数目
Dim bytMaxZeroAdd
bytMaxZeroAdd = Len(CStr(lngMaxIndex))

Rem 重命名处理
regex.Pattern = "(\D*)(\d+)(.*)"
For Each File In Files
        For Each strMatch In regex.Execute(File.Name)
                File.Move _
                        File.ParentFolder&"\"& _
                        strMatch.Submatches(0) & _
                        String(bytMaxZeroAdd - Len(CStr(CLng(strMatch.Submatches(1)))),"0") & _
                        CStr(CLng(strMatch.Submatches(1))) & _
                        strMatch.Submatches(2)
        Next
Next
[/code][color=Red]文件夹补0重命名.vbs[/color][code]Rem Code by OldLiu
Option Explicit
Dim fso,Folders
Set fso = CreateObject("Scripting.FileSystemObject")
If wsh.Arguments.Count <> 1 Then wsh.Quit
Set Folders = fso.GetFolder(wsh.Arguments(0)).SubFolders

Dim regex
Set regex = New RegExp
regex.Global = False
regex.Pattern = "\D*(\d+)"

Rem 得到最大索引
Dim Folder,lngMaxIndex,strMatch
lngMaxIndex = 0
For Each Folder In Folders
        For Each strMatch In regex.Execute(Folder.Name)
                If CLng(strMatch.Submatches(0)) > lngMaxIndex Then
                        lngMaxIndex = CLng(strMatch.Submatches(0))
                End If
        Next
Next
If lngMaxIndex = 0 Then wsh.Quit 1

Rem 计算最大补0数目
Dim bytMaxZeroAdd
bytMaxZeroAdd = Len(CStr(lngMaxIndex))

Rem 重命名处理
regex.Pattern = "(\D*)(\d+)(.*)"
For Each Folder In Folders
        For Each strMatch In regex.Execute(Folder.Name)
                Folder.Move _
                        Folder.ParentFolder&"\"& _
                        strMatch.Submatches(0) & _
                        String(bytMaxZeroAdd - Len(CStr(CLng(strMatch.Submatches(1)))),"0") & _
                        CStr(CLng(strMatch.Submatches(1))) & _
                        strMatch.Submatches(2)
        Next
Next
[/code]

页: [1]

Powered by Discuz! Archiver 7.2  © 2001-2009 Comsenz Inc.