How to import a directory listing into a table including dates and times (1 Viewer)

[syd053]

Hi All,

I am after creating a method to import a complete file listing of all files in a certain directory to a table. In addition to this however i require the full path of each file, the created date and the modified date to be part of this import process. The reason I need this is to identify changes in a directory from a certain time onwards.

Any help/suggestions will be greatly appreciated

Thanks

Martin

 

[Addyman]

This is an excellent starting point:

http://allenbrowne.com/ser-59alt.html

I have used this myself and have also created variations of it for specific tasks as well.

If you have any queries regarding it, let me know as I have used it a lot!

 

[DrallocD]

If you want created/modified date you will need to use the fso object

Public Sub listFiles(startFolder As String, Optional recurse As Boolean = False)
On Error GoTo ErrorHappened
    Dim fso, folder, file, subfolder
    Set fso = CreateObject("Scripting.FileSystemObject")
 
    If LenB(startFolder) = 0 Then Exit Sub
 
    If Right(startFolder, 1) <> "\" Then startFolder = startFolder & "\"
 
    Set folder = fso.GetFolder(startFolder)
    For Each file In folder.files
        Debug.Print file.Path, file.DateLastModified, file.DateCreated, file.Size
    Next
    If recurse Then
        For Each subfolder In folder.SubFolders
            listFiles subfolder.Path, recurse
        Next
    End If
ExitNow:
    On Error Resume Next
    Set fso = Nothing
    Set folder = Nothing
    Set file = Nothing
    Set subfolder = Nothing
    Exit Sub
ErrorHappened:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
    Resume ExitNow
End Sub

 

[DrallocD]

You should use parentheses when calling functions, not subs. In the immediate window try:

listQFiles "H:\SharePoint\"

and

listQFiles "H:\SharePoint\", True

 

[Hrithika]

DrallocD,

I used your code taking up some ideas from allen browne's method to insert the file properties in a table. Everything was working just fine until I decided to add file.Duration into the equation. After that I am getting an error message "Error 438(Object doesn't support this property or method)" Any suggestion to improve the code to get the extended properties.


Public Sub listQFiles(startFolder As String, Optional recurse As Boolean = True)
On Error GoTo ErrorHappened
Dim fso, folder, file, subfolder
Dim strSQL2 As String
Dim frname As String
Dim frpath As String
Dim frsize As String
Dim frduration As String

Set fso = CreateObject("Scripting.FileSystemObject")

If LenB(startFolder) = 0 Then Exit Sub

If Right(startFolder, 1) <> "\" Then startFolder = startFolder & "\"

Set folder = fso.GetFolder(startFolder)
For Each file In folder.Files
Debug.Print file.Name, file.Path, file.DateLastModified, file.DateCreated, file.Size, file.Duration
frname = file.Name
frpath = file.Path
frsize = file.Size
frduration = file.Duration
'strSQL2 = "Insert into Files (FName, FPath, FSize) select " & frname & "," & frpath & "," & frsize & ";"
strSQL2 = "Insert into QFiles (FName, FPath, FSize, FDuration) select '" & frname & "','" & frpath & "','" & frsize & "','" & frduration & "';"
CurrentDb.Execute strSQL2
Next
If recurse Then
For Each subfolder In folder.SubFolders
For Each file In subfolder.Files
'listFiles subfolder.Path, recurse
frname = file.Name
frpath = file.Path
frsize = file.Size
frduration = file.Duration
strSQL2 = "Insert into QFiles (FName, FPath, FSize, FDuration) select '" & frname & "','" & frpath & "','" & frsize & "','" & frduration & "';"
CurrentDb.Execute strSQL2
Next
Next
End If
ExitNow:
On Error Resume Next
Set fso = Nothing
Set folder = Nothing
Set file = Nothing
Set subfolder = Nothing
Exit Sub
ErrorHappened:
MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
Resume ExitNow
End Sub

 

[DrallocD]

This is an example of how you can get this ("Duration" is "Length" in Vista and Windows 7).

Public Function GetExtendedAttr(ByRef fileName As String, Optional ByRef attrName As String = vbNullString)
On Error GoTo ErrorHappened
Dim oShell
Dim oDir
Dim oFile
Dim intAttrID As Integer
Dim i As Integer
Set oShell = CreateObject("Shell.Application")
Set oDir = oShell.Namespace(Left(fileName, InStrRev(fileName, "\")))
intAttrID = -1
Set oFile = oDir.ParseName(Mid(fileName, InStrRev(fileName, "\") + 1))
If intAttrID < 0 Then
For i = 1 To 266
If oDir.GetDetailsOf(fileName, i) = attrName Then
intAttrID = i
Exit For
End If
Next i
End If
Debug.Print "FileName = " & fileName
Debug.Print IIf(intAttrID >= 0, attrName & "(" & intAttrID & ") = ", vbNullString) & oDir.GetDetailsOf(oFile, intAttrID)
ExitNow:
On Error Resume Next
Set oFile = Nothing
Set oDir = Nothing
Set oDir = Nothing
Set oShell = Nothing
Exit Function
ErrorHappened:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetExtendedAttr"
Resume ExitNow
End Function

debug.print GetExtendedAttr("C:\1.mp3")
FileName = C:\1.mp3
Item type: MP3 Format Sound
Size: 5.02 MB
Contributing artists: VA
Length: 00:05:19

debug.print GetExtendedAttr("C:\1.mp3", "Length")
FileName = C:\1.mp3
Length(27) = 00:05:19

 

[Hrithika]

Awesome. Thank you so much.