AW: FileSystemObject
22.11.2016 12:13:01
baschti007
Hey Marcel
Dazu gibt es schon was im netz
Hier
Sub ListFiles()
'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 = "Folder"
Range("B1").Value = "File Name"
Range("C1").Value = "File Size"
Range("D1").Value = "File Type"
Range("E1").Value = "Date Created"
Range("F1").Value = "Date Last Accessed"
Range("G1").Value = "Date Last Modified"
'Assign the top folder to a variable
strTopFolderName = "C:\Bastian"
'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 = objFolder.Path
Cells(NextRow, "B").Value = objFile.Name
Cells(NextRow, "C").Value = objFile.Size
Cells(NextRow, "D").Value = objFile.Type
Cells(NextRow, "E").Value = objFile.DateCreated
Cells(NextRow, "F").Value = objFile.DateLastAccessed
Cells(NextRow, "G").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
Gruß Basti