*****如何批量让同文件夹的图片文件名，跟文件夹名一样？******

make08

如何批量让同文件夹的图片文件名，跟文件夹名一样？
例如2009文件夹里有三张图，把这三张图命名为2009  2009（1） 2009（2）
新建文件夹 (2).rar (2.72 KB, 下载次数: 79)

2015-4-9 11:34 上传

点击文件名下载附件

光之马

你试下吧，如果相同文件名的文件已经存在，会报错

蓝桥玄霜

1. Sub lqxs()
   
2. Dim fp$, fn, i&, aa, nm$, nm1$
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4.     With Application.FileDialog(msoFileDialogFolderPicker)
   
5.         .Title = "请选择目标文件夹"
   
6.         .Show
   
7.         If .SelectedItems.Count = 0 Then MsgBox "没有选择文件夹,程序退出!", 64, "提示": Exit Sub
   
8.         fp = .SelectedItems(1)
   
9.     End With
   
10.     aa = InStrRev(fp, "")
    
11.     nm = Right(fp, Len(fp) - aa)
    
12.     fn = Dir(fp & "\*.png")
    
13.     Do While fn <> ""
    
14.         i = i + 1
    
15.         If i = 1 Then
    
16.             nm1 = nm & ".png"
    
17.         Else
    
18.             nm1 = nm & "(" & i - 1 & ").png"
    
19.         End If
    
20.         Name fp & "" & fn As fp & "" & nm1
    
21.         fn = Dir
    
22.     Loop
    
23. End Sub
    

复制代码

蓝桥玄霜

请见附件。

make08

蓝桥玄霜 发表于 2015-4-9 12:34

谢谢蓝桥版主，不过只能一个一个文件夹的选择吗？

make08

光之马 发表于 2015-4-9 12:23
你试下吧，如果相同文件名的文件已经存在，会报错

谢谢光之马大师，不过，每改一个文件名，都要点一下“确定”，能否再帮我改进下？

光之马

make08 发表于 2015-4-9 13:11
谢谢光之马大师，不过，每改一个文件名，都要点一下“确定”，能否再帮我改进下？

1. 
   
2. Public Sub 读取()
   
3. Dim f, ff, fff, fff1, i%, j%
   
4. On Error Resume Next
   
5. i = 1
   
6. Set f = CreateObject("scripting.filesystemobject")
   
7. Set ff = f.getfolder(ThisWorkbook.Path)
   
8. Set fff = ff.subfolders
   
9. For Each fff1 In fff
   
10. Sheet1.Cells(i, 1).Value = fff1.Name
    
11. i = i + 1
    
12. Next
    
13. i = 1
    
14. For i = 1 To Range("a65536").End(xlUp).Row
    
15.     j = 0
    
16.     Set ff = f.getfolder(ThisWorkbook.Path & "" & Cells(i, 1).Value)
    
17.     Set fff = ff.Files
    
18.         For Each fff1 In fff
    
19.         If j = 0 Then
    
20.         fff1.Name = Cells(i, 1).Value & ".jpg"
    
21.         Else
    
22.         fff1.Name = Cells(i, 1).Value & "(" & j & ").jpg"
    
23.         End If
    
24.         j = j + 1
    
25.         Next
    
26. Next
    
27. End Sub
    

复制代码

make08

光之马 发表于 2015-4-9 13:13

感谢光之马大师，解决好了，谢谢！佩服！

zdc52061

光之马 发表于 2015-4-9 13:13

执行不了？现在不能用了吗？

lu5521674

光之马 发表于 2015-4-9 13:13

有办法恢复到之前吗，不小心把桌面的文件全改成图片格式了