一、代码部分

'示例制作：竹笛
'网站：www.umvsoft.com
'日期：2007-5-21
'函数摘自www.access911.net

Private Sub cmdOK_Click()
    Dim ff() As String
    Dim fn As Long
    Dim i As Long
    Dim mySource As String
    Me.lstFile.RowSource = ""
    If Not IsNull(Me.txtDisk) Then
    '显示EXCEL文件，如果要显示Word文件，则改为*.doc
        fn = TreeSearch(Me.txtDisk, "*.xls", ff())
        For i = 1 To fn
            If i > 1 Then
                Me.lstFile.RowSource = Me.lstFile.RowSource & ";" & ff(i)
            Else
                Me.lstFile.RowSource = ff(i)
            End If
        Next
    Else
        MsgBox "请输入文件夹路径！", vbCritical, "提示"
    End If
    Me.lstFile.Requery
End Sub

Private Function TreeSearch(ByVal sPath As String, ByVal sFileSpec As String, sFiles() As String) As Long
    Static lngFiles As Long
    Dim lngIndex As Long
    Dim strDir As String
    Dim strSubDirs() As String
        If Right(sPath, 1) <> "\" Then
        sPath = sPath & "\"
    End If
   
    strDir = Dir(sPath & sFileSpec)
    Do While Len(strDir)
        lngFiles = lngFiles + 1
        ReDim Preserve sFiles(1 To lngFiles)
        sFiles(lngFiles) = sPath & strDir
        strDir = Dir
    Loop
        lngIndex = 0
    strDir = Dir(sPath & "*.*", 16)
   
    Do While Len(strDir)
        If Left(strDir, 1) <> "." Then
            If GetAttr(sPath & strDir) And vbDirectory Then
                lngIndex = lngIndex + 1
                ReDim Preserve strSubDirs(1 To lngIndex)
                strSubDirs(lngIndex) = sPath & strDir & "\"
            End If
        End If
        strDir = Dir
    Loop
        For lngIndex = 1 To lngIndex
        Call TreeSearch(strSubDirs(lngIndex), sFileSpec, sFiles())
    Next lngIndex
  TreeSearch = lngFiles
End Function