Question Dump File Info

MOTOWN44

Registered User.
Local time
Today, 12:09
Joined
Aug 18, 2009
Messages
42
Hello Everyone

I have this code that I got from allenbrowne here > http://allenbrowne.com/ser-59alt.html which does exactly what I want, I was just wondering if anyone would help me make it get more information on the files??

Ideally I need Date Modified and File Type along with the Path and file name it already gets for me.

The code is

Code:
Option Compare Database
Option Explicit
Dim gCount As Long
''
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

Code:
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)
   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"
 
    Stop: Resume
 
    Resume Exit_Handler
End Function

Code:
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 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
    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 Files " _
    & " (FName, FPath) " _
    & " SELECT ""  ~~~ ERROR ~~~""" _
    & ", """ & strFolder & """;"
    CurrentDb.Execute strSQL
 
    Resume Exit_Handler
End Function

Code:
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

Im normally alright at modifying code but this goes straight over my head as I cant even see where its getting the Name and Path from!

Thanks in advance
 

Users who are viewing this thread

Back
Top Bottom