list files in a directory to worksheet in Excel

[TheJocker1236]

Hi,
I found this code in the Internet.
I want to extract the the names, the saved location path and the size of a files.
Can someone help me?
the cord must be able extract all file types and the the files in the sub directories.

Code

Sub Test() Dim xRow As Long Dim xDirect$, xFname$, InitialFoldr$ InitialFoldr$ = "C:\Desktop" '<<< Startup folder to begin searching from With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = Application.DefaultFilePath & "" .Title = "Please select a folder to list Files from" .InitialFileName = InitialFoldr$ .Show If .SelectedItems.Count <> 0 Then xDirect$ = .SelectedItems(1) & "" xFname$ = Dir(xDirect$, 7) Do While xFname$ <> "" ActiveCell.Offset(xRow) = Left(xFname$, InStrRev(xFname$, ".") - 1) xRow = xRow + 1 xFname$ = Dir Loop End If End With End Sub

<tbody>
</tbody>

\Code

 

[Logit]

Put This Code in a Module, and change the directory information to search:

Force the explicit delcaration of variablesOption Explicit


Sub ListFiles()


    'Set a reference to Microsoft Scripting Runtime by using
    'Tools > References in the Visual Basic Editor (Alt+F11)
    
    'Declare the variables
    Dim objFSO As Scripting.FileSystemObject
    Dim objTopFolder As Scripting.Folder
    Dim strTopFolderName As String
    
    'Insert the headers for Columns A through F
    Range("A1").Value = "File Name"
    Range("B1").Value = "File Size"
    Range("C1").Value = "File Type"
    Range("D1").Value = "Date Created"
    Range("E1").Value = "Date Last Accessed"
    Range("F1").Value = "Date Last Modified"
    
    'Assign the top folder to a variable
[B][COLOR=#ff0000]    strTopFolderName = "C:\Users\My\Documents"              ''CHANGE THIS FOR THE DIRECTORY YOU WISH TO SEARCH[/COLOR][/B]
    
    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    'Get the top folder
    Set objTopFolder = objFSO.GetFolder(strTopFolderName)
    
    'Call the RecursiveFolder routine
    Call RecursiveFolder(objTopFolder, True)
    
    'Change the width of the columns to achieve the best fit
    Columns.AutoFit
    
End Sub


Sub RecursiveFolder(objFolder As Scripting.Folder, _
    IncludeSubFolders As Boolean)


    'Declare the variables
    Dim objFile As Scripting.File
    Dim objSubFolder As Scripting.Folder
    Dim NextRow As Long
    
    'Find the next available row
    NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    'Loop through each file in the folder
    For Each objFile In objFolder.Files
        Cells(NextRow, "A").Value = objFile.Name
        Cells(NextRow, "B").Value = objFile.Size
        Cells(NextRow, "C").Value = objFile.Type
        Cells(NextRow, "D").Value = objFile.DateCreated
        Cells(NextRow, "E").Value = objFile.DateLastAccessed
        Cells(NextRow, "F").Value = objFile.DateLastModified
        NextRow = NextRow + 1
    Next objFile
    
    'Loop through files in the subfolders
    If IncludeSubFolders Then
        For Each objSubFolder In objFolder.SubFolders
            Call RecursiveFolder(objSubFolder, True)
        Next objSubFolder
    End If
    
End Sub

 

[TheJocker1236]

Thanks Man

 

[Logit]

Your welcome.

Merry Christmas !