知行合一

批量改后缀的VBS

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

赞(0) 打赏
未经允许不得转载:嘟嘟鱼 » 批量改后缀的VBS
分享到: 更多 (0)

觉得文章有用就打赏一下文章作者

支付宝扫一扫打赏

微信扫一扫打赏