VBS脚本批量更改文件后缀名

VBScript

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

复制代码

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