批量更改后缀

张雄友

将 《批量更改后缀》文件夹中："bmp","jpg", "tif", "png" 后缀名的图片，

更改为： 以"gif"为 后缀名的图片。

jsxjd

更改后还能用吗？

张雄友

jsxjd 发表于 2013-8-5 20:28
更改后还能用吗？

肯定要可以用的。

crazy0qwer

张雄友 发表于 2013-8-5 20:30
肯定要可以用的。

想法挺好的。

zhaogang1960

短信收到，请测试：

1. Sub Macro1()
   
2.     Dim Dic As Object, Fso As Object, i&, arr
   
3.     Application.ScreenUpdating = False
   
4.     Set Fso = CreateObject("Scripting.FileSystemObject")
   
5.     Set Dic = CreateObject("scripting.dictionary")
   
6.     arr = Array(".bmp", ".jpg", ".tif", ".png") '："bmp","jpg", "tif", "png"
   
7.     For i = 0 To UBound(arr)
   
8.         Dic(arr(i)) = ""
   
9.     Next
   
10.     Call GetFiles(ThisWorkbook.Path, Fso, Dic)
    
11.     Set Fso = Nothing
    
12.     Set Dic = Nothing
    
13.     Application.ScreenUpdating = True
    
14.     MsgBox "ok"
    
15. End Sub
    
16. 
    
17. Private Sub GetFiles(ByVal sPath$, Fso As Object, Dic As Object)
    
18.     Dim Folder As Object
    
19.     Dim SubFolder As Object
    
20.     Dim File As Object
    
21.     Dim temp$
    
22.     Set Folder = Fso.GetFolder(sPath)
    
23.     If sPath <> ThisWorkbook.Path Then
    
24.         For Each File In Folder.Files
    
25.             temp = Right$(File.Name, 4)
    
26.             If Dic.Exists(temp) Then
    
27.                 File.Copy Replace(File, temp, ".gif")
    
28.                 File.Delete
    
29.             End If
    
30.         Next
    
31.     End If
    
32.     If Folder.SubFolders.Count > 0 Then
    
33.         For Each SubFolder In Folder.SubFolders
    
34.             Call GetFiles(SubFolder.Path, Fso, Dic)
    
35.         Next
    
36.     End If
    
37.     Set Folder = Nothing
    
38.     Set File = Nothing
    
39.     Set SubFolder = Nothing
    
40. End Sub
    

复制代码

zhaogang1960

请看附件
批量更改后缀.rar (1.05 MB, 下载次数: 56)

2013-8-6 12:19 上传

点击文件名下载附件

LMY123

批量修改后缀，子文件夹

long635000

直接改可能照片会有问题 吧