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

定敏

zhaogang1960 发表于 2013-1-12 11:22

运行后提示：

zhaogang1960

定敏 发表于 2013-1-12 12:19
运行后提示：

估计你的C盘进行了安全设置，请不要把照片放到C盘了
请看操作演示：

定敏

zhaogang1960 发表于 2013-1-12 12:37
估计你的C盘进行了安全设置，请不要把照片放到C盘了
请看操作演示：

您好zhaogang1960 老师，很感谢您对我的热心帮助，可我就是完成不了，您再帮我看看这个好吗？再谢。 新建文件夹.rar (187.89 KB, 下载次数: 5)

2013-1-12 12:50 上传

点击文件名下载附件

zhaogang1960

定敏 发表于 2013-1-12 12:50
您好zhaogang1960 老师，很感谢您对我的热心帮助，可我就是完成不了，您再帮我看看这个好吗？再谢。

附件中有的身份证号为空，会导致出错，加个判断：

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.         If Len(arr(i, 12)) Then '判断有身份证号
   
10.             f = p & arr(i, 1) & ".jpg"
    
11.             If Dir(f) <> "" Then Name f As p & arr(i, 12) & ".jpg"
    
12.         End If
    
13.     Next
    
14.     MsgBox "ok"
    
15. End Sub

复制代码

zhaogang1960

请注意，身份证号为空不重新命名：
新建文件夹.rar (183.07 KB, 下载次数: 17)

2013-1-12 13:21 上传

点击文件名下载附件

定敏

zhaogang1960 发表于 2013-1-12 13:19
附件中有的身份证号为空，会导致出错，加个判断：

谢谢您，赵刚老师，您真是帮了我的大忙了。

定敏

zhaogang1960 发表于 2013-1-12 13:19
附件中有的身份证号为空，会导致出错，加个判断：

赵老师，我想了解一下每一句的含义，麻烦您再对所写的各句逐一加注释好吗？谢谢了。

zhaogang1960

定敏 发表于 2013-1-12 13:33
赵老师，我想了解一下每一句的含义，麻烦您再对所写的各句逐一加注释好吗？谢谢了。

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) 'B:M列数据写入数组
   
8.     For i = 1 To UBound(arr) '逐行数据
   
9.         If Len(arr(i, 12)) Then '判断有身份证号
   
10.             f = p & arr(i, 1) & ".jpg" '原照片路径+文件名
    
11.             If Dir(f) <> "" Then Name f As p & arr(i, 12) & ".jpg" '先判断该文件存在，在重新命名：身份证号.jpg
    
12.         End If
    
13.     Next
    
14.     MsgBox "ok"
    
15. End Sub

复制代码

定敏

zhaogang1960 发表于 2013-1-12 14:01

您太厉害了，谢谢您。