We help IT Professionals succeed at work.

ms/access programmatically get a list of fils and folders

114 Views
Last Modified: 2017-04-19
I had this question after viewing ms/access get folder and file list.

On my ms/access app, I need to populate a table with filenames and their paths. It is doing so but, I cannot get to have the separate list of folders and empty folders that I need to populate the table.

My DB is attached and I the code I am using is:

ON THE IMMEDIATE window:

Call ListFiles("E:\01 preparacao\06 dgrh", , True)


ON THE MODULE:

Option Compare Database

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
            ' get the file name from the varItem
            strFileName = Replace(Right(varItem, Len(varItem) - InStrRev(varItem, "\")), "'", "''")
            strFilePath = Replace(Left(varItem, InStrRev(varItem, "\")), "'", "''")
            ' add 1 record to the Table of files
            strSetSQL = "INSERT INTO fileTable (fileName, filePath, fileType)"
            strSetSQL = strSetSQL & " VALUES ('" & strFileName & "', '" & strFilePath & "', 'file' ) "
            DoCmd.SetWarnings False
            DoCmd.RunSQL strSetSQL
            DoCmd.SetWarnings True
        Next
    Else
        For Each varItem In colDirList
        lst.AddItem varItem
        Next
    End If

Exit_Handler:
    Exit Function

Err_Handler:
    If Err = 52 Then
        'add the file to the table
        Err.Clear
        Resume Next
    End If
    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 strSetSQL As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant
   
    On Error GoTo Err_Handler

    ' check if folder is empty
    If Nz(Dir(strFolder & "\*.*"), "") = "" Then
        'folder is empty
        'place codes to record the folder path and name
        strFilePath = Replace(Left(strFolder, InStrRev(strFolder, "\")), "'", "''")
        ' add 1 record to the Table of files
        FileName = "empty folder"
        strSetSQL = "INSERT INTO fileTable (fileName, filePath, fileType)"
        strSetSQL = strSetSQL & " VALUES ('" & strFileName & "', '" & strFilePath & "', 'folder' )    "
        Exit Function
    End If
    '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
   
   
Exit_Handler:
    Exit Function

   
Err_Handler:
    If Err = 52 Then
        'add the file to the table
        Err.Clear
        strSetSQL = "INSERT INTO fileTable (fileName, filePath, fileError) "
        strSetSQL = strSetSQL & " VALUES ('" & strFileName & "', '" & strFilePath & "', & 'Error 52') "
        DoCmd.SetWarnings False
        DoCmd.RunSQL strSetSQL
        DoCmd.SetWarnings True
        Resume Next
    End If
    If Err = 53 Then
        'add the file to the table
        Err.Clear
        strSetSQL = "INSERT INTO fileTable (fileName, filePath, fileError) "
        strSetSQL = strSetSQL & " VALUES ('" & strFileName & "', '" & strFilePath & "', & 'Error 53') "
        DoCmd.SetWarnings False
        DoCmd.RunSQL strSetSQL
        DoCmd.SetWarnings True
        Resume Next
    End If
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Exit_Handler
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


can anyone help?

(the table is OK, but how to get just the folders is not...
Database3.accdb
Comment
Watch Question

CERTIFIED EXPERT
Top Expert 2016
Commented:
Unlock this solution and get a sample of our free trial.
(No credit card required)
UNLOCK SOLUTION
gee Thanks!!!!!
 now I am on to the non-empty folders (the empty ones show...)

Will try to do on my own and come back for help if I fail..
Thanks again!

Up and running

now I just need to past to the main app code....

Gain unlimited access to on-demand training courses with an Experts Exchange subscription.

Get Access
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Empower Your Career
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Unlock the solution to this question.
Thanks for using Experts Exchange.

Please provide your email to receive a sample view!

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.