Question

如何用Excel做某个文件夹下所有文件（包括子文件夹中的文件）的列表清单，包括最后修改 时间等信息？

我在网上找了很多EXCEL的代码，终于找到一个比较合我意的解决方法，先发下代码：
Sub XXX()
Dim i As Integer
Dim MyPath As String, MyName As String
i = 1
Sheet1.Cells.Clear
MyPath = "C:\XXX"
MyName = Dir(MyPath, vbArchive)
Do While MyName <> ""
If MyName <> "." And MyName <> ".." Then
If GetAttr(MyPath & MyName) = vbArchive Then
Sheet1.Cells(i, 1) = MyName
Sheet2.Cells(i, 2) = FileLen(MyPath & MyName)
Sheet3.Cells(i, 3) = FileDateTime(MyPath & MyName)
i = i + 1
End If
End If
MyName = Dir
Loop
End Sub

这段代码运行的效果应该是列出存储于路径为C:\XXX\文件夹下的所有txt文件的对象属性，并将文件名，文件长度及文件修改时间列出。
不过这代码打出来的效果和我期望中的有不一致的地方。不知哪位大神可以帮忙改一改，小弟费劲脑汁也只能读懂VBS的大概意思，但让我去修改实在是难上加难。
以下是些许疑问，以及希望改进的地方：
1.Sheet1.Cells.Clear这前面的Sheet1是否指的是指定在工作表1中作业？可否去掉以适应所有工作表？如果可以去掉请问如何改动。
2.这个代码运行的结果好像是不包含子文件夹文件的，如何添加命令以达到我预期，也就是包含子目录文件的效果？
3.不知这段代码是加到ThisWorkBook还是加到对应表的模块中？
4.我试运行这段代码，发现只能列出文本文件，可我不知道那句是筛选格式的，求教并希望改成列出所有格式文件。

以上，恳请指导。
对不起，代码有误。
Sheet1.Cells(i, 1) = MyName
Sheet2.Cells(i, 2) = FileLen(MyPath & MyName)
Sheet3.Cells(i, 3) = FileDateTime(MyPath & MyName)
应该改成
Sheet1.Cells(i, 1) = MyName
Sheet1.Cells(i, 2) = FileLen(MyPath & MyName)
Sheet1.Cells(i, 3) = FileDateTime(MyPath & MyName)

Answer 1

1、 Sheet1.Cells.Clear 改 ActiveSheet.Cells(i, 1).Clear 表示当前激活的工作表
2、要遍历子目录，比较复杂，用递归比较好。现在没那么多时间写。。。网上貌似有代码吧。
3、加到哪里都是一样的，因为都是指定了工作表的，像me.cells() 这样写就表示代码所在表，这样才必须要在自动表内，你上面的代码都指定了表名，放哪都可以。
4、 MyName = Dir(MyPath & "*.txt", vbArchive) 这样指定txt文件。

追问

谢谢说的我差不多懂了。
遍历子目录这个，我确实有找到很多代码，只是都只有列举文件名和路径的，没有加修改时间的。我不知道改怎么把这几句揉进去。。。

这样，我现在有个遍历子目录的代码，要不我发一下你看看能不能二合一。。那代码我看着头疼，不知道从哪里下手

追答

九八七一二二八一七 扣我，或者HI我，我给个代码你。
不会失效吧？

Dim i As Long
Sub FindFile()
i = 1
ActiveSheet.Cells.Clear
Call SearchFiles("E:\", "*.*")
MsgBox "完成"
End Sub

Private Function SearchFiles(Path As String, FileType As String)
Dim Folder() As String '文件夹路径
Dim a, b, c As Long
Dim sPath As String
If Right(Path, 1) "\" Then Path = Path & "\"
'--------------------------------------------------------------查找文件
sPath = Dir(Path & FileType) '查找第一个文件
Do While Len(sPath) '循环到没有文件为止
ActiveSheet.Cells(i, 1) = sPath
ActiveSheet.Cells(i, 2) = FileLen(Path & sPath)
ActiveSheet.Cells(i, 3) = FileDateTime(Path & sPath)
i = i + 1
sPath = Dir '查找下一个文件
DoEvents '让出控制权
Loop
'---------------------------------------------------------------查找文件夹
sPath = Dir(Path & "\", vbDirectory) '查找第一个文件夹
Do While Len(sPath) '循环到没有文件夹为止
If Left(sPath, 1) "." Then '为了防止重复查找
If GetAttr(Path & "\" & sPath) And vbDirectory Then '判断是否为文件夹
b = b + 1
ReDim Preserve Folder(1 To b)
Folder(b) = Path & sPath & "\" '将目录和文件夹名称放到数组
End If
End If
sPath = Dir
DoEvents
Loop
'-----------------------------------------------------调用自身，递归查找字目录
For c = 1 To b
SearchFiles Folder(c), FileType
Next
End Function

追问

快下班了，不知道你晚上有时间没，我回去加你吧。
不过目标文件夹用的自定义图标，有desktop.ini，我试了一下其他文件夹都可以搜索唯独这个改过图标的文件夹不行。
算了，回去秋秋说吧OK？

Answer 2

我改了一下程序，看适用于你不？
Sub XXX()
Dim i As Integer, j As Integer
Dim MyPath As String, MyName As String
i = 1
Sheets(1).Cells.Clear
MyPath = "C:\xxx"
With Application.FileSearch
.LookIn = "C:\xxx"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Sheets(1).Cells(i, 1) = .FoundFiles(i)
Sheets(1).Cells(i, 2) = FileLen(.FoundFiles(i))
Sheets(1).Cells(i, 3) = FileDateTime(.FoundFiles(i))
Next
End If
End With
End Sub

追问

我试过了，可是如此改过之后会出错，第五行"Sheets.Cells.Clear"中的".Cells"被选中，并提示方法和数据成员未找到。
而且我觉得您这么改未必能达到我所要求的其他效果。。

追答

第五行的sheets改为activesheet
sheets(2),sheets(3),均改为sheets(1)

追问

运行了，这次没出错，可是没有任何反应，表中没有数据出现。

追答

Sub XXX()
Dim i As Integer, j As Integer
Dim MyPath As String, MyName As String
i = 1
Sheets(1).Cells.Clear
MyPath = "C:\xxx"
With Application.FileSearch
.LookIn = "C:\xxx"
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Sheets(1).Cells(i, 1) = .FoundFiles(i)
Sheets(1).Cells(i, 2) = FileLen(.FoundFiles(i))
Sheets(1).Cells(i, 3) = FileDateTime(.FoundFiles(i))
Next
End If
End With
End Sub

追问

抱歉，之前你改动的是有效果的，我觉得可能是命令上的问题，要打c:\而不是c:，这样才有结果。
不过这次改动貌似和之前没有差别。我希望是子文件夹下的文件也列出来啊。。但这次改动之后还是和以前一样的，没有遍历。