Board logo

标题: [转贴] VBS脚本批量更改文件后缀名 [打印本页]

作者: VBScript    时间: 2012-4-28 17:38     标题: VBS脚本批量更改文件后缀名

  1. Dim ar
  2. Set ar = WScript.Arguments
  3. If ar.Count = 0 Then
  4. MsgBox "请把包含要按顺序Rename的文件的文件夹拖放到本程序的图标上!", 4160, "提示"
  5. Set ar = Nothing
  6. WScript.Quit
  7. End If
  8. Public szExt, szExtNew, l, mf, r, fso, a
  9. szExt = InputBox("请输入要Rename的文件后缀名:", "确定文件类型", "bin")
  10. szExt = Trim(szExt)
  11. While Left(szExt, 1) = "."
  12. szExt = Mid(szExt, 2)
  13. Wend
  14. szExt = "." & szExt
  15. l = Len(szExt)
  16. If l < 1 Then
  17. MsgBox "后缀名太短!", 4112, "错误"
  18. Set ar = Nothing
  19. WScript.Quit
  20. End If
  21. szExtNew = InputBox("请输入要Rename后文件的后缀名:", "确定改后的后缀名", "bmp")
  22. szExtNew = Trim(szExtNew)
  23. While Left(szExtNew, 1) = "."
  24. szExtNew = Mid(szExtNew, 2)
  25. Wend
  26. szExtNew = "." & szExtNew
  27. If Len(szExtNew) < 1 Then
  28. MsgBox "后缀名太短!", 4112, "错误"
  29. Set ar = Nothing
  30. WScript.Quit
  31. End If
  32. mf = InputBox("请输入存放Rename后文件的文件夹:", "确定存放文件夹", ar(0))
  33. mf = Trim(mf)
  34. While Right(mf, 1) = "\"
  35. mf = Left(mf, Len(mf) - 1)
  36. Wend
  37. r = MsgBox("处理后是否删除原文件?", 4131, "确定移动还是复制")
  38. If r = 2 Then WScript.Quit
  39. Set fso = CreateObject("Scripting.FileSystemObject")
  40. If Not fso.FolderExists(mf) Then
  41. MsgBox "用来存放Rename后的文件的文件夹不存在!", 4112, "错误"
  42. Set ar = Nothing
  43. Set fso = Nothing
  44. WScript.Quit
  45. End If
  46. For Each a In ar
  47. If fso.FolderExists(a) Then Call Rename(a)
  48. Next
  49. Set ar = Nothing
  50. Set fso = Nothing
  51. MsgBox "整个世界清净了!", 4160, "搞定!"
  52. Private Sub Rename(ByVal fd)
  53. Dim rfd, fs, f, p
  54. Set rfd = fso.GetFolder(fd)
  55. Set fs = rfd.Files
  56. For Each f In fs
  57.   If StrComp(Right(f.Name, l), szExt, 1) = 0 Then
  58.    p = mf & "\" & Left(f.Name, Len(f.Name) - l) & szExtNew
  59. '   MsgBox p
  60.    If Not fso.FileExists(p) Then
  61.     If r = 6 Then
  62.      f.Move p
  63.     Else
  64.      f.Copy p
  65.     End If
  66.    End If
  67.   End If
  68. Next
  69. Set fds = rfd.SubFolders
  70. For Each fd In fds
  71.   Rename fd.Path
  72. Next
  73. End Sub
复制代码


http://foxhack.blog.51cto.com/96963/32854




欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2