List properties of all files in a folder

[mukeshnic]

I've some files in a folder. I want to list properties (e.g. name, size, type, date modified etc.) of these files in an excel worksheet.

Need VBA code. Thank in advance

 

[Blade Hunter]

Public Function FileSize()
Dim FSO As Object
Set FSO = CreateObject("scripting.filesystemobject")
FileSize = FSO.FileSize("C:\Windows\Windows.exe")
End Function

This function gives you the file size of the windows.exe file.

You can use this as a foundation to build what you need.

Go here for more info on the FSO: http://msdn.microsoft.com/en-us/library/6tkce7xa(VS.85).aspx

Cheers

Dan

 

[mukeshnic]

Thanks a lot Dan

Cheers
Mukesh

 

[Blade Hunter]

No worries, be sure to post back if you need more help

Dan

 

[Legacy 98055]

Hi Mukesh. Above and beyond what Dan has already helped you with, there are some thorough writeups with code on this site and elsewhere. I have seen them. Here is a google search of this website:

http://www.google.com/search?source...tnG=Google+Search&aq=f&aqi=&aql=&oq=&gs_rfai=

 

[mukeshnic]

Thanks Tom

I found this code:

Public X()
Public i As Long
Public objShell, objFolder, objFolderItem
Public FSO, oFolder, Fil
Sub MainExtractData()
    Dim NewSht As Worksheet
    Dim MainFolderName As String
    Dim TimeLimit As Long, StartTime As Double
    ReDim X(1 To 65536, 1 To 12)
    Set objShell = CreateObject("Shell.Application")
    TimeLimit = Application.InputBox("Please enter the maximum time that you wish this code to run for in minutes" & vbNewLine & vbNewLine & _
                                     "Leave this at zero for unlimited runtime", "Time Check box", 0)
    StartTime = Timer
    Application.ScreenUpdating = False
    MainFolderName = BrowseForFolder()
    Set NewSht = ThisWorkbook.Sheets.Add
    X(1, 1) = "Path"
    X(1, 2) = "File Name"
    X(1, 3) = "Last Accessed"
    X(1, 4) = "Last Modified"
    X(1, 5) = "Created"
    X(1, 6) = "Type"
    X(1, 7) = "Size"
    X(1, 8) = "Owner"
    X(1, 9) = "Author"
    X(1, 10) = "Title"
    X(1, 11) = "Comments"
    X(1, 12) = "More Info"
    i = 1
    Set FSO = CreateObject("scripting.FileSystemObject")
    Set oFolder = FSO.GetFolder(MainFolderName)
    'error handling to stop the obscure error that occurs at time when retrieving DateLastAccessed
    On Error Resume Next
    For Each Fil In oFolder.Files
        Set objFolder = objShell.Namespace(oFolder.path)
        Set objFolderItem = objFolder.ParseName(Fil.Name)
        i = i + 1
        If i Mod 20 = 0 And TimeLimit <> 0 And Timer > (TimeLimit * 60 + StartTime) Then
            GoTo FastExit
        End If
        If i Mod 50 = 0 Then
            Application.StatusBar = "Processing File " & i
            DoEvents
        End If
        X(i, 1) = oFolder.path
        X(i, 2) = Fil.Name
        X(i, 3) = Fil.DateLastAccessed
        X(i, 4) = Fil.DateLastModified
        X(i, 5) = Fil.DateCreated
        X(i, 6) = Fil.Type
        X(i, 7) = Fil.Size
        X(i, 8) = objFolder.GetDetailsOf(objFolderItem, 8)
        X(i, 9) = objFolder.GetDetailsOf(objFolderItem, 9)
        X(i, 10) = objFolder.GetDetailsOf(objFolderItem, 10)
        X(i, 11) = objFolder.GetDetailsOf(objFolderItem, 14)
        X(i, 12) = objFolder.GetDetailsOf(objFolderItem, 24)
    Next
    'Get subdirectories
    If TimeLimit = 0 Then
        Call RecursiveFolder(oFolder, 0)
    Else
        If Timer < (TimeLimit * 60 + StartTime) Then Call RecursiveFolder(oFolder, TimeLimit * 60 + StartTime)
    End If
FastExit:
    Range("A:L") = X
    If i < 65535 Then Range(Cells(i + 1, "A"), Cells(65536, "A")).EntireRow.Delete
    Range("A:L").WrapText = False
    Range("A:L").EntireColumn.AutoFit
    Range("1:1").Font.Bold = True
    Rows("2:2").Select
    ActiveWindow.FreezePanes = True
    Range("a1").Activate
    Set FSO = Nothing
    Set objShell = Nothing
    Set oFolder = Nothing
    Set objFolder = Nothing
    Set objFolderItem = Nothing
    Set Fil = Nothing
    Application.StatusBar = ""
    Application.ScreenUpdating = True
End Sub
Sub RecursiveFolder(xFolder, TimeTest As Long)
    Dim SubFld
    For Each SubFld In xFolder.SubFolders
        Set oFolder = FSO.GetFolder(SubFld)
        Set objFolder = objShell.Namespace(SubFld.path)
        For Each Fil In SubFld.Files
            Set objFolder = objShell.Namespace(oFolder.path)
            'Problem with objFolder at times
            If Not objFolder Is Nothing Then
                Set objFolderItem = objFolder.ParseName(Fil.Name)
                i = i + 1
                If i Mod 20 = 0 And TimeTest <> 0 And Timer > TimeTest Then
                    Exit Sub
                End If
                If i Mod 50 = 0 Then
                    Application.StatusBar = "Processing File " & i
                    DoEvents
                End If
                X(i, 1) = SubFld.path
                X(i, 2) = Fil.Name
                X(i, 3) = Fil.DateLastAccessed
                X(i, 4) = Fil.DateLastModified
                X(i, 5) = Fil.DateCreated
                X(i, 6) = Fil.Type
                X(i, 7) = Fil.Size
                X(i, 8) = objFolder.GetDetailsOf(objFolderItem, 8)
                X(i, 9) = objFolder.GetDetailsOf(objFolderItem, 9)
                X(i, 10) = objFolder.GetDetailsOf(objFolderItem, 10)
                X(i, 11) = objFolder.GetDetailsOf(objFolderItem, 14)
                X(i, 12) = objFolder.GetDetailsOf(objFolderItem, 24)
            Else
                Debug.Print Fil.path & " " & Fil.Name
            End If
        Next
        Call RecursiveFolder(SubFld, TimeTest)
    Next
End Sub
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'Function purpose:  To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE:  If invalid, it will open at the Desktop level
    Dim ShellApp As Object
    'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
                   BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
    'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.path
    On Error GoTo 0
    'Destroy the Shell Application
    Set ShellApp = Nothing
    'Check for invalid or non-entries and send to the Invalid error
    'handler if found
    'Valid selections can begin L: (where L is a letter) or
    '\\ (as in [URL="file://\\servername\sharename"]\\servername\sharename[/URL].  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select
    Exit Function
Invalid:
    'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
End Function