List files to a table

        9 votes: *****      41,658 views      1 comments
by Allen Browne, 05 February 2009    (Access 2000+)

Microsoft Access Tips for Serious Users

Provided by Crystal (Microsoft Access MVP), April 2007. Based on code by Allen Browne, adapted from a Usenet posting by Albert Kallal (Microsoft Access MVP.)

List files to a table

The article, List files recursively, explained how to loop through the files in a folder and subfolders, displaying the results in a list box. This alternative writes the files to a table instead of a list box. See the original article for an explanation of the code.

To use this in your database:

  1. Create a new table, with these fields:
    • FileID        AutoNumber (primary key)
    • FName      Text (50 characters)
    • FPath        Text (255 characters)
    • DateCreated  Date/Time.  Set Default value to: =Now()
    Save the table with the name Files.
  2. Create a new module.
    In Access 2000 - 2003, click the Modules tab of the database window, and click New.
    In Access 2007, click the Create tab on the ribbon, drop-down the right-most icon on the Other group, and choose Module.
    Access opens the code window.
  3. Copy the code below, and paste into your new module.
  4. Choose Compile in the Debug menu, to verify Access understands the code.
  5. Save the module with a name such as ajbFileList.

Using the code

In the Immediate window

To list the files in C:\Data, open the Immediate Window (Ctrl+G), and enter:
    Call ListFilesToTable("C:\Data")

To limit the results to zip files:
    Call ListFilesToTable("C:\Data", "*.zip")

To include files in subdirectories as well:
    Call ListFilesToTable("C:\Data", , True)

The Code

Option Compare Database
Option Explicit

'list files to tables

Dim gCount As Long ' added by Crystal

Sub runListFiles()
    'Usage example.
    Dim strPath As String _
    , strFileSpec As String _
    , booIncludeSubfolders As Boolean
    strPath = "E:\"
    strFileSpec = "*.*"
    booIncludeSubfolders = True
    ListFilesToTable strPath, strFileSpec, booIncludeSubfolders
End Sub

'crystal modified parameter specification for strFileSpec by adding default value
Public Function ListFilesToTable(strPath As String _
    , Optional strFileSpec As String = "*.*" _
    , Optional bIncludeSubfolders As Boolean _
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.
    'Method:    FilDir() adds items to a collection, calling itself recursively for subfolders.
    Dim colDirList As New Collection
    Dim varitem As Variant
    Dim rst As DAO.Recordset
   Dim mStartTime As Date _
      , mSeconds As Long _
      , mMin As Long _
      , mMsg As String
   mStartTime = Now()
    Call FillDirToTable(colDirList, strPath, strFileSpec, bIncludeSubfolders)
   mSeconds = DateDiff("s", mStartTime, Now())
   mMin = mSeconds \ 60
   If mMin > 0 Then
      mMsg = mMin & " min "
      mSeconds = mSeconds - (mMin * 60)
      mMsg = ""
   End If
   mMsg = mMsg & mSeconds & " seconds"
   MsgBox "Done adding " & format(gCount, "#,##0") & " files from " & strPath _
      & IIf(Len(Trim(strFileSpec)) > 0, " for file specification --> " & strFileSpec, "") _
      & vbCrLf & vbCrLf & mMsg, , "Done"
   SysCmd acSysCmdClearStatus
    Exit Function

    MsgBox "Error " & Err.Number & ": " & Err.Description, , "ERROR"
    'remove next line after debugged -- added by Crystal
    Stop: Resume 'added by Crystal
    Resume Exit_Handler
End Function

Private Function FillDirToTable(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
    On Error GoTo Err_Handler
    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant
    Dim strSQL As String

    'Add the files to the folder.
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
         gCount = gCount + 1
         SysCmd acSysCmdSetStatus, gCount
         strSQL = "INSERT INTO Files " _
          & " (FName, FPath) " _
          & " SELECT """ & strTemp & """" _
          & ", """ & strFolder & """;"
         CurrentDb.Execute strSQL
        colDirList.Add strFolder & strTemp
        strTemp = Dir

    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
        'Call function recursively for each subfolder.
        For Each vFolderName In colFolders
            Call FillDirToTable(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
        Next vFolderName
    End If

    Exit Function

    strSQL = "INSERT INTO Files " _
    & " (FName, FPath) " _
    & " SELECT ""  ~~~ ERROR ~~~""" _
    & ", """ & strFolder & """;"
    CurrentDb.Execute strSQL
    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
            TrailingSlash = varIn & "\"
        End If
    End If
End Function

HomeIndex of tipsTop

Rate this article:   Your rating: Poor Your rating: Not so good Your rating: Average Your rating: Good Your rating: Excellent

This is a cached tutorial, reproduced with permission.

Have your say - comment on this article.

What did you think of 'List files to a table'?


MannySP says...

01 June 2013

This was exactly what I was looking for. Thank you.

Have your say...

E-mail (e-mail address will be kept private)
Verify Code
Verification Code

It may take 30 seconds after clicking submit - please be patient to avoid duplicate submissions.  

All comments must be approved before being displayed on this web page.  This process may take up to 24 hours.