|
本帖最后由 zjdh 于 2011-9-11 09:23 编辑
这个不难:- Sub 批量更名()
- Dim TH As Object, Directory$
- Dim OB As Object
- Dim DT, FL, A$, T, M&
- On Error Resume Next
- T = Timer
- N = InputBox("请输入文件扩展名", "选择", "PNG")
- If N = "" Then Exit Sub
- N = UCase(N)
- A = InputBox("请输入更名前缀", "选择", "A")
- If A = "" Then Exit Sub
- A = UCase(A)
- Set TH = CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件目录:", &H1)
- If Not TH Is Nothing Then
- Directory = TH.self.Path
- If Not Directory Like "*" Then Directory = Directory & ""
- End If
- Set OB = CreateObject("Scripting.FileSystemObject")
- Set DT = OB.GetFolder(Directory)
- For Each FL In DT.Files
- If UCase(Split(FL.Name, ".")(1)) = N Then
- M = M + 1
- FL.Name = A & Format(M, "00000") & "." & N
- End If
- Next
- If M = "" Then MsgBox "【 " & Directory & " 】目录中没有" & N & "文件"
- MsgBox "共有" & M & "个文件已更名,请检查!" & Chr(13) & "共用时" & Format(Timer - T, "0.00") & " 秒!!"
- End Sub
复制代码 |
评分
-
查看全部评分
|