Solved

Access function help with folder and file list

Posted on 2009-05-13
5
302 Views
Last Modified: 2013-11-27
Hello EE,

From different sources I have gotten multiple ways to pull folder, subfolder, and file information using Access 2003.  The code below represents the easiest way for me to get folders, their subfolders, and file name info into an Access table.  However, it does not provide the file date or the file size.  I added the DIMs, but don't know how to pull the date and size as it is looping through.  Can you help?  The bulk of the code below is courtesy of Allen Browne.

Thanks,

LVBarnes
Sub runListFiles()

    'Usage example.

    Dim strPath As String

    Dim strFileSpec As String

    Dim booIncludeSubfolders As Boolean

    Dim gCount As Long

    Dim FileDate As String

    Dim FileSize As Long

    

            

    strPath = "C:\"

    strFileSpec = "*.*"

    booIncludeSubfolders = True

    

    ListFilesToTable strPath, strFileSpec, booIncludeSubfolders

End Sub
 

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

    Dim mSeconds As Long

    Dim mMin As Long

    Dim mMsg As String

    Dim gCount As Long

      

      

   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)

   Else

      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"

  

Exit_Handler:

   SysCmd acSysCmdClearStatus

   '--------

    

    Exit Function
 

Err_Handler:

    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

    Dim gCount As Long

    Dim FileDate As String

    Dim FileSize As Long
 

    'Add the files to the folder.

    strFolder = TrailingSlash(strFolder)

    strTemp = Dir(strFolder & strFileSpec)

    'FileDate = HELP HERE

    Do While strTemp <> vbNullString

         gCount = gCount + 1

         SysCmd acSysCmdSetStatus, gCount

         strSQL = "INSERT INTO tblFiles " & " (FName, FPath, FDate, FSize) " & _

         " SELECT """ & strTemp & """" & ", """ & strFolder & """, """ & FileDate & """, """ & FileSize & """;"

         CurrentDb.Execute strSQL

        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 FillDirToTable(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)

        Next vFolderName

    End If
 

Exit_Handler:

    

    Exit Function
 

Err_Handler:

    strSQL = "INSERT INTO tblFiles " _

    & " (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

        Else

            TrailingSlash = varIn & "\"

        End If

    End If

End Function

Open in new window

0
Comment
Question by:Lawrence Barnes
  • 3
  • 2
5 Comments
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 24379546


 strTemp = Dir(strFolder & strFileSpec)
    'FileDate = HELP HERE

     FileDate=fileDateTime(strFolder & strFileSpec)
     
     FileSize=fileLen(strFolder & strFileSpec)
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 24379559
oops sorry

strTemp = Dir(strFolder & strFileSpec)
    'FileDate = HELP HERE

     FileDate=fileDateTime(strFolder & strTemp)
     
     FileSize=fileLen(strFolder & strTemp)
0
 
LVL 5

Author Comment

by:Lawrence Barnes
ID: 24379830
Hi Capricorn :)

Thanks to you I am now getting a file date and a file size :)  BUT, thanks to me I'm getting the same file date/file size for every file within a directory.  Probably because it's in the wrong part of the loop.  I'll continue to hack on it.. but could you tell me where I should place the filedate/filesize code?  New code pasted below.

I could startup another question if needed.

LVBarnes
Option Compare Database
 

Option Explicit
 

Sub runListFiles()

    'Usage example.

    Dim strPath As String

    Dim strFileSpec As String

    Dim booIncludeSubfolders As Boolean

    Dim gCount As Long

    Dim FileDate As String

    Dim FileSize As Long

    

            

    strPath = "C:\"

    strFileSpec = "*.*"

    booIncludeSubfolders = True

    

    ListFilesToTable strPath, strFileSpec, booIncludeSubfolders

End Sub
 

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

    Dim mSeconds As Long

    Dim mMin As Long

    Dim mMsg As String

    Dim gCount As Long

      

      

   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)

   Else

      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"

  

Exit_Handler:

   SysCmd acSysCmdClearStatus

   '--------

    

    Exit Function
 

Err_Handler:

    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

    Dim gCount As Long

    Dim FileDate As String

    Dim FileSize As Long
 

    'Add the files to the folder.

    strFolder = TrailingSlash(strFolder)

    strTemp = Dir(strFolder & strFileSpec)

    FileDate = FileDateTime(strFolder & strTemp)

    FileSize = FileLen(strFolder & strTemp)

    

    Do While strTemp <> vbNullString

         gCount = gCount + 1

         SysCmd acSysCmdSetStatus, gCount

         strSQL = "INSERT INTO tblFiles " & " (FName, FPath, FDate, FSize) " & _

         " SELECT """ & strTemp & """" & ", """ & strFolder & """, """ & FileDate & """, """ & FileSize & """;"

         CurrentDb.Execute strSQL

        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 FillDirToTable(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)

        Next vFolderName

    End If
 

Exit_Handler:

    

    Exit Function
 

Err_Handler:

    strSQL = "INSERT INTO tblFiles " _

    & " (FName, FPath, FDate, FSize) " _

    & " SELECT ""  ~~~ ERROR ~~~""" _

    & ", """ & strFolder & """, """ & FileDate & """, """ & FileSize & """;"

    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

        Else

            TrailingSlash = varIn & "\"

        End If

    End If

End Function

Open in new window

0
 
LVL 119

Accepted Solution

by:
Rey Obrero earned 500 total points
ID: 24379847


place it inside the loop


   
    Do While strTemp <> vbNullString

         FileDate = FileDateTime(strFolder & strTemp)
          FileSize = FileLen(strFolder & strTemp)
0
 
LVL 5

Author Closing Comment

by:Lawrence Barnes
ID: 31581209
Thank you again Capricorn :)
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

It took me quite some time to sort out all the different properties of combo and list boxes available from Visual Basic at run-time. Not that the documentation is lacking: the help pages are quite thorough and well written. The problem was rather wh…
Regardless of which version on MS Access you are using, one of the harder data-entry forms to create is one where most data from previous entries needs to be appended to new records, especially when there are numerous fields and records involved.  W…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
In Microsoft Access, learn how to use Dlookup and other domain aggregate functions and one method of specifying a string value within a string. Specify the first argument, which is the expression to be returned: Specify the second argument, which …

919 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now