注册
登录
| 关键词： nbsp szExtNew Then szExt Set 后缀 WScript 文件 Rename MsgBox |
小脚本！netpatch写给他GF修改图片的，顺便发出来给需要的人，稍微修改了下，支持自定义后缀 szBuf = InputBox( "请老婆大人输入修改后保存的文件名："&Chr(13)&Chr(10)&"图片测试#.webp"&Chr(13)&Chr(10)&"#从1开始，依次变化到文件总数"&Chr(13)&Chr(10)&"图片测试1.webp"&Chr(13)&Chr(10)&"图片测试2.webp"&Chr(13)&Chr(10)&"......"&Chr(13)&Chr(10)&"图片测试999.webp", "输入", "图片测试#.webp" )If szBuf <> "" Then MyVar = MsgBox ("确认输入的是:"&szBuf, 1, "输入确认！") If myvar = 2 Then wsh.quitElse wsh.quitEnd Ifstr=InstrRev(szBuf, "#", -1, 1)new_name=Mid(szBuf,1,str-1)ext=Mid(szBuf,str+2,Len(szBuf))'nzero=UBound(Split(szBuf,"#",-1,1))Set fso = CreateObject("Scripting.FileSystemObject")Function ShowFolderList(folderspec) Dim f, f1, fc, s Set f = fso.GetFolder(folderspec) Set fc = f.Files For Each f1 in fc If LCase(fso.GetExtensionName(f1))= ext Then s = s & f1.name&"|" End If Next ShowFolderList = sEnd Function Set Wshell = WScript.CreateObject("WScript.Shell")allfiles=ShowFolderList(Wshell.CurrentDirectory) files=Split(allfiles,"|",-1,1)n=1For Each p In files If fso.FileExists(Wshell.CurrentDirectory&"\"&p) Then fso.getfile(Wshell.CurrentDirectory&"\"&p).name=new_name&n&"."&ext n=n+1 Else Exit For End If Next lcx版 Dim ar Set ar = WScript.Arguments If ar.Count = 0 Then MsgBox "请把包含要按顺序Rename的文件的文件夹拖放到本程序的图标上！", 4160, "提示" Set ar = Nothing WScript.Quit End If Public szExt, szExtNew, l, mf, r, fso, a szExt = InputBox("请输入要Rename的文件后缀名：", "确定文件类型", "bin") szExt = Trim(szExt) While Left(szExt, 1) = "." szExt = Mid(szExt, 2) Wend szExt = "." & szExt l = Len(szExt) If l < 1 Then MsgBox "后缀名太短！", 4112, "错误" Set ar = Nothing WScript.Quit End If szExtNew = InputBox("请输入要Rename后文件的后缀名：", "确定改后的后缀名", "bmp") szExtNew = Trim(szExtNew) While Left(szExtNew, 1) = "." szExtNew = Mid(szExtNew, 2) Wend szExtNew = "." & szExtNew If Len(szExtNew) < 1 Then MsgBox "后缀名太短！", 4112, "错误" Set ar = Nothing WScript.Quit End If mf = InputBox("请输入存放Rename后文件的文件夹：", "确定存放文件夹", ar(0)) mf = Trim(mf) While Right(mf, 1) = "\" mf = Left(mf, Len(mf) - 1) Wend r = MsgBox("处理后是否删除原文件？", 4131, "确定移动还是复制") If r = 2 Then WScript.Quit Set fso = CreateObject("Scripting.FileSystemObject") If Not fso.FolderExists(mf) Then MsgBox "用来存放Rename后的文件的文件夹不存在！", 4112, "错误" Set ar = Nothing Set fso = Nothing WScript.Quit End If For Each a In ar If fso.FolderExists(a) Then Call Rename(a) Next Set ar = Nothing Set fso = Nothing MsgBox "整个世界清净了！", 4160, "搞定！" Private Sub Rename(ByVal fd) Dim rfd, fs, f, p Set rfd = fso.GetFolder(fd) Set fs = rfd.Files For Each f In fs If StrComp(Right(f.Name, l), szExt, 1) = 0 Then p = mf & "\" & Left(f.Name, Len(f.Name) - l) & szExtNew ' MsgBox p If Not fso.FileExists(p) Then If r = 6 Then f.Move p Else f.Copy p End If End If End If Next Set fds = rfd.SubFolders For Each fd In fds Rename fd.Path Next End Sub |
|
声明：文章版权归原作者所有 部分文章转自互联网 如有侵权请联系
[邮箱地址] 删除
|
