[已解决]批量更改后缀

张雄友

批量更改图片后缀名。
将 后缀名为："bmp","jpg", "tif", "png" 的图片

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

最佳答案

月排行榜 / 总排行榜

爱疯

2013-8-5 21:09

批量更改后缀3.rar (722.66 KB, 下载次数: 62)

2013-8-5 21:08 上传

点击文件名下载附件

跳转到最佳答案楼层

张雄友

就是将文件夹中的所有后缀名为："bmp","jpg", "tif", "png" 的图片

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

爱疯大师，图片不是有很多类型吗？就是将后缀名为："bmp","jpg", "tif", "png" 的图片改为： "gif" 后缀名的图片。

爱疯

Dim FSO As Object, a(1 To 10 ^ 4, 1 To 3), s
Sub test1()
    Dim i, oldpathname, newpathname
   
    Set FSO = CreateObject("scripting.filesystemobject")
    test2 ThisWorkbook.Path
    '
    For i = 1 To s
        If InStr("bmp,jpg,tif,png", a(i, 3)) Then
            oldpathname = a(i, 1) & a(i, 2) & "." & a(i, 3)
            newpathname = a(i, 1) & a(i, 2) & "." & "gif"
            Name oldpathname As newpathname
        End If
    Next i
End Sub
'
Sub test2(MyPath As String)
    Dim Folder As Object, SubFolder As Object
    Dim FileCollection As Object, FileName As Object
    '
    Set Folder = FSO.getfolder(MyPath)
    Set FileCollection = Folder.Files
    For Each FileName In FileCollection
        s = s + 1
        a(s, 1) = MyPath & "\"
        a(s, 2) = FSO.GetBaseName(MyPath & FileName)
        a(s, 3) = FSO.GetExtensionName(MyPath & FileName)
    Next
    '
    For Each SubFolder In Folder.SubFolders
        test2 SubFolder.Path
    Next
End Sub

批量更改后缀2.rar (721.31 KB, 下载次数: 15)

2013-8-5 20:29 上传

点击文件名下载附件
我只是个普通爱好者。这样可以吗

张雄友

爱疯 发表于 2013-8-5 20:30
Dim FSO As Object, a(1 To 10 ^ 4, 1 To 3), s
Sub test1()
    Dim i, oldpathname, newpathname

全部更改后，可不可以这样，就是如果保存了，就全部更改；

如果不保存就恢复原来的样子。可以做到吗？

爱疯

“如果保存了，就全部更改”
这句是什么含义？

张雄友

爱疯 发表于 2013-8-5 20:44
“如果保存了，就全部更改”
这句是什么含义？

就是执行代码后，关闭EXCEL工作簿，提示是否保存，如果保存就全部更改后缀，如果不保存，就不更改后缀。

爱疯

在工作簿里修改：在关闭工作簿并且还未保存时，会提示是否保存。
执行改名操作：name语句执行后，文件名就改了，不会有提示。

所以，只有在执行test1之前，加个msgbox，提醒是否改名。

张雄友

爱疯 发表于 2013-8-5 20:56
在工作簿里修改：在关闭工作簿并且还未保存时，会提示是否保存。
执行改名操作：name语句执行后，文件名就 ...

在哪里改？

爱疯

批量更改后缀3.rar (722.66 KB, 下载次数: 62)

2013-8-5 21:08 上传

点击文件名下载附件

suye1010

Option Explicit
Dim FSO As Object
Sub RName()
    Set FSO = CreateObject("scripting.filesystemobject")
    BatchReName ThisWorkbook.Path & Application.PathSeparator
End Sub

Sub BatchReName(FolderPath)
On Error Resume Next
    Dim Folder As Object
    Dim SubFolder As Object
    Dim SFile As Object
    Set Folder = FSO.getfolder(FolderPath)
    For Each SFile In Folder.Files
        If InStr(SFile.Name, ".bmp") Then SFile.Name = Replace(SFile.Name, ".bmp", ".gif")
        If InStr(SFile.Name, ".jpg") Then SFile.Name = Replace(SFile.Name, ".jpg", ".gif")
        If InStr(SFile.Name, ".tif") Then SFile.Name = Replace(SFile.Name, ".tif", ".gif")
        If InStr(SFile.Name, ".png") Then SFile.Name = Replace(SFile.Name, ".png", ".gif")
    Next
    For Each SubFolder In Folder.SubFolders
        BatchReName SubFolder
    Next
End Sub