office交流網--QQ交流群號

Access培訓群:792054000         Excel免費交流群群:686050929          Outlook交流群:221378704    

Word交流群:218156588             PPT交流群:324131555

access遞歸列齣文件夾中的文件

2019-10-18 16:22:00
Allen Browne
翻譯
3224

本文介紹如何在VBA中遞歸列齣文件,在列錶框中顯示文件路徑和文件名

前麵的我們講過類似的實例Access穫取文件夾內的文件名及路徑,下麵函數的功能更加完整


Public Function ListFiles(strPath As String, Optional strFileSpec As String, _
    Optional bIncludeSubfolders As Boolean, Optional lst As ListBox)
On Error GoTo Err_Handler
    'Purpose:   List the files in the path.
    'Arguments: strPath = the path to search.
    '           strFileSpec = "*.*" unless you specify differently.
    '           bIncludeSubfolders: If True, returns results from subdirectories of strPath as well.
    '           lst: if you pass in a list box, items are added to it. If not, files are listed to immediate window.
    '               The list box must have its Row Source Type property set to Value List.
    'Method:    FilDir() adds items to a collection, calling itself recursively for subfolders.
    Dim colDirList As New Collection
    Dim varItem As Variant
    
    Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)
    
    'Add the files to a list box if one was passed in. Otherwise list to the Immediate Window.
    If lst Is Nothing Then
        For Each varItem In colDirList
            Debug.Print varItem
        Next
    Else
        For Each varItem In colDirList
        lst.AddItem varItem
        Next
    End If

Exit_Handler:
    Exit Function

Err_Handler:
    MsgBox "Error " & 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)
    'Build up a list of files, and then add add to this list, any additional folders
    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant

    'Add the files to the folder.
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
        colDirList.Add strFolder & strTemp
        strTemp = Dir
    Loop

    If bIncludeSubfolders Then
        'Build collection of additional subfolders.
        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
        'Call function recursively for each subfolder.
        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



名爲“lstFileList列錶框,併設置行來源類型爲“值列錶
在代碼中調用函數, Call ListFiles("D:\OfficeCn\Office Addin", , , Me.lstFileList)




衕理,還可以:
列齣D:\OfficeCn\Office Addin中的文件

Call ListFiles("D:\OfficeCn\Office Addin")

列齣D:\OfficeCn\Office Addin中後綴爲.zip的文件

Call ListFiles(""D:\OfficeCn\Office Addin", "*.zip")

列齣D:\OfficeCn\Office Addin中的文件,併列齣子文件夾下的文件

Call ListFiles("D:\OfficeCn\Office Addin", , True)




    分享