标签:VBA,自定义函数
我想要列出文件夹及其子文件夹中名为test的Excel文件,如何使用VBA程序实现?
使用下面的程序,假设文件夹路径为:C:\Users\excelperfect\Desktop\未完成。你可以根据实际情况修改该路径。
Sub test()
Dim lst As ListBox
Dim i As Long
ListFiles "C:\Users\excelperfect\Desktop\未完成", "*st.xls*", True, lst
On Error Resume Next
For i = 0 To lst.ListCount - 1
Debug.Print lst.List(i).Value
Next
End Sub
'目的: 列出路径中的文件.
'参数: strPath = 要搜索的路径.
' strFileSpec = "*.*" 除非另有指定.
' bIncludeSubfolders: 如果为True,同时从strPath的子文件夹中返回结果.
' lst: 如果传递到列表框, 则在其中添加项. 如果不, 则将文件在立即窗口列出.
' 列表框必须具有其Row Source Type属性设置为Value列表.
'方法:FilDir()添加项到集合, 对子文件夹递归调用自身.
Public Function ListFiles(ByVal strPath As String, Optional ByVal strFileSpec As String = "*.*", _
Optional ByVal bIncludeSubfolders As Boolean = False, Optional ByRef lst As ListBox = Nothing)
On Error GoTo Err_Handler
Dim colDirList As New Collection
Dim varItem As Variant
Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)
'如果传入,将其添加到列表框中.否则,将列表添加到即时窗口中.
If lst Is Nothing Then
For Each varItem In colDirList
Debug.Print varItem
DoEvents
Next
Else
For Each varItem In colDirList
lst.AddItem varItem
Next
End If
Exit_Handler:
Exit Function
Err_Handler:
MsgBox "错误 " & Err.Number & ": " & Err.Description
Resume Exit_Handler
End Function
Private Function FillDir(colDirList As Collection, ByVal strFolder As String, strFileSpec As String, _
bIncludeSubfolders As Boolean)
'创建文件列表, 然后添加到该列表
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant
On Error Resume Next
'添加文件到文件夹.
strFolder = TrailingSlash(strFolder)
strTemp = Dir(strFolder & strFileSpec)
Do While strTemp <> vbNullString
colDirList.Add strFolder & strTemp
strTemp = Dir
Loop
If bIncludeSubfolders Then
'建立另外子文件夹的集合.
strTemp = Dir(strFolder, vbDirectory)
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then
If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
colFolders.Add strTemp
End If
End If
strTemp = Dir
Loop
'对每个子文件夹递归调用函数.
For Each vFolderName In colFolders
Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
Next vFolderName
End If
End Function
Public Function TrailingSlash(varIn As Variant) As String
If Len(varIn) > 0& Then
If Right(varIn, 1&) = "\" Then
TrailingSlash = varIn
Else
TrailingSlash = varIn & "\"
End If
End If
End Function
可以看到,程序使用了一个自定义函数ListFiles,可以列出所有文件。
注:本程序整理自vbaexpress.com,供有兴趣的朋友研究。