一、搜索每个文件夹的文件
截图
首先要引用Microsoft Scripting Runtime组件。
1、逐一读取文件夹和子文件夹的路径放在excel表的第1列。
2、逐一读取表中的文件夹的路径,找出该文件夹下的全部文件,逐一显示文件的路径在右列的单元格。
使用方法:使用时只要将支持宏的excel表放在需要查找文件的文件夹中
Dim arrfilejia(1 To 10000) '创建一个数组空间,用来存放文件名称 Dim wenjians '文件夹个数 Dim k ’excel表录入的行数。
Public Sub wenjianjia() On Error Resume Next
Dim path as string '声明文件路径 Dim I as integer
Dim fso As New filesystemobject, fd As folder '创建一个filesystemobject对象和一个文件夹对象
If Right(ThisWorkbook.Path, 1) = \’ 设置要遍历的文件夹目录,如果没有”\\”则加上”\\”。
path = ThisWorkbook.Path Else
path = ThisWorkbook.Path & \End If
cntfiles = 0 k = 5
Set fd = fso.getfolder(path) '设置fd文件夹对象 searchwenjianjia fd '调用子程序搜索文件 Call wenjian End Sub
Sub searchwenjianjia(ByVal fd As folder) On Error Resume Next Dim fl As file Dim sfd As folder
If fd.subfolders.Count = 0 Then Exit Sub '返回由指定文件夹中所有子文件夹(包括隐藏文件夹和系统文件夹)组成的folders集合
For Each sfd In fd.subfolders 'folders集合进行循环查找 wenjians = wenjians + 1
arrfilejia(wenjians) = sfd.Path
Sheet1.Cells(k, 1) = arrfilejia(wenjians) & \k = k + 1
searchwenjianjia sfd '使用递归方法查找下一个文件夹 Next End Sub
‘下面子程序主要是从excel表的第一列读出路径。将文件的路径名写在右列。 Sub wenjian()
On Error Resume Next
Dim sr As String, n As Integer For t = 5 To 10000 n = 2
expath = Cells(t, 1) If expath <> \sr = Dir(expath) If sr <> \Do
Sheet1.Cells(t, n) = expath & sr n = n + 1 sr = Dir
Loop Until sr = \End If End If Next End Sub
以上程序获得文件的路径后,可以统一进行文件名的规范命名。当文档的数量比较多时,这种方法的优势明显。重命名的内容不要是应用程序使用的文件。改名后会导致文件不可用。
二、执行文件重命名操作:
Sub renamewenjian() For i = 5 To 10000
If Sheet1.Cells(i, 1) <> \
Name Sheet1.Cells(i, 1) As Sheet1.Cells(i, 2) Sheet1.Cells(i, 3) = \成功\Else
Sheet1.Cells(i, 3) = \不成功\Exit For End If Next End Sub
excelvba的实例-列出文件夹下的文件并执行文件重命名操作



