如何以条件批量命名新文件

定敏

有一系列图片，原来是以人名命名的，现在，我想以其对应的身份证号码命名（也就是以表中的M列内容命名），但EXCEL表与图片文件是在同一大文件夹下的不同子文件夹中，该如何做：






现在传上附件，谢谢老师们：
新建文件夹.zip (24.82 KB, 下载次数: 26)

2013-1-11 23:12 上传

点击文件名下载附件

该贴已经同步到 定敏的微博

zhaogang1960

请测试:

1. Sub Macro1()
   
2.     Dim arr, i&, p$, f$
   
3.     p = ThisWorkbook.Path & "" '请自己修改路径
   
4.     arr = Range("B2:M" & Range("B65536").End(xlUp).Row)
   
5.     For i = 1 To UBound(arr)
   
6.         f = p & arr(i, 1) & ".jpg"
   
7.         If Dir(f) <> "" Then Name f As f = p & arr(i, 12) & ".jpg"
   
8.     Next
   
9.     MsgBox "ok"
   
10. End Sub

复制代码

vs2010

1. Sub test()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. array1 = Sheet1.[A2:A8]
   
4. array2 = Sheet1.[B2:B8]
   
5. For i = 1 To 8 - 1
   
6. 
   
7. d(array1(i, 1) & ".jpg") = array2(i, 1)
   
8. Next
   
9. Path = "E:\aa"
   
10. file = Dir(Path & "*.jpg")
    
11. 
    
12. While file <> ""
    
13.    
    
14.     Name Path & file As Path & d(file) & ".jpg"
    
15.     file = Dir
    
16. Wend
    
17. End Sub

复制代码

部分需要改动

zhaogang1960

针对1楼附件修改一下，不使用固定路径了，用户指定文件夹：

1. Sub Macro1()
   
2.     Dim arr, i&, p$, f$
   
3.     With Application.FileDialog(msoFileDialogFolderPicker)
   
4.         If .Show = False Then Exit Sub
   
5.         p = .SelectedItems(1) & ""
   
6.     End With
   
7.     arr = Range("B2:M" & Range("B65536").End(xlUp).Row)
   
8.     For i = 1 To UBound(arr)
   
9.         f = p & arr(i, 1) & ".jpg"
   
10.         If Dir(f) <> "" Then Name f As p & arr(i, 12) & ".jpg"
    
11.     Next
    
12.     MsgBox "ok"
    
13. End Sub
    

复制代码

南海

留着备用，学习

定敏

zhaogang1960 发表于 2013-1-11 23:20
请测试:

不好意思，我第一次接触VBA，不知道怎么用，比如照片的路径为：C:\Documents and Settings\Administrator\桌面\网络版操作手册\本校各班学生照片\一年级。
表格的路径为：C:\Documents and Settings\Administrator\桌面\网络版操作手册\各班上传模板，该如何做，谢谢。

定敏

vs2010 发表于 2013-1-11 23:21
部分需要改动

怎么运行啊？我把代码复制到VBA编辑窗口，按F5，它就再现了一个运行宏的窗口，可宏列表里是空白的。

定敏

Sub Macro1()
    Dim arr, i&, p$, f$
    p = "D:\本校各班学生照片\一年级" & "\"
    arr = Range("B2:M" & Range("B65536").End(xlUp).Row)
    For i = 1 To UBound(arr)
        f = p & arr(i, 1) & ".jpg"
        If Dir(f) <> "" Then Name f As f = p & arr(i, 12) & ".jpg"
    Next
    MsgBox "ok"
End Sub
帮我看一看，为什么运行了，提示文件已存在呢？

zhaogang1960

定敏 发表于 2013-1-12 09:02
不好意思，我第一次接触VBA，不知道怎么用，比如照片的路径为：C:\Documents and Settings\Administrator ...

1. Sub Macro1()
   
2.     Dim arr, i&, p$, f$
   
3.     p = "C:\Documents and Settings\Administrator\桌面\网络版操作手册\本校各班学生照片\一年级"
   
4.     arr = Range("B2:M" & Range("B65536").End(xlUp).Row)
   
5.     For i = 1 To UBound(arr)
   
6.         f = p & arr(i, 1) & ".jpg"
   
7.         If Dir(f) <> "" Then Name f As f = p & arr(i, 12) & ".jpg"
   
8.     Next
   
9.     MsgBox "ok"
   
10. End Sub
    

复制代码

zhaogang1960

定敏 发表于 2013-1-12 09:44
Sub Macro1()
    Dim arr, i&, p$, f$
    p = "D:\本校各班学生照片\一年级" & "\"

或使用4楼代码，程序会弹出一个对话框，让你选择一个文件夹，请看演示和附件：
新建文件夹.rar (28.42 KB, 下载次数: 10)

2013-1-12 11:27 上传

点击文件名下载附件