I have Excel-2007. I am using File System Object VBA code to list files in a directory. I have also set up reference to Microsoft Scriptlet Library in excel. I am getting:
Compiler error:User-defined type not defined
on this very first code line
Dim FSO As Scripting.FileSystemObject
Code used by me as follows:
Sub ListFilesinFolder()
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim FileItem As Scripting.File
SourceFolderName = "C:\mydir"
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
Range("A1:C1") = Array("text file", "path", "Date Last Modified")
i = 2
For Each FileItem In SourceFolder.Files
Cells(i, 1) = FileItem.Name
Cells(i, 2) = FileItem
Cells(i, 3) = FileItem.DateLastModified
i = i + 1
Next FileItem
Set FSO = Nothing
End Sub
Can someone point out where am I going wrong?
**UPDATE -03-09-2015**
I have updated my program based on @brettdj program and some research to list all files including sub-folder files. It works for me. I look forward to suggestions to further improve it.
Sub ListFilesinFolder()
Dim objFSO As Object
Dim ws As Worksheet
Dim cl As Range
Dim objFolderName As String
objFolderName = "C:\FY_2015-2016\sunil"
Set objFSO = New Scripting.FileSystemObject
Set ws = ActiveSheet
With Range("A1:C1")
.Value2 = Array("File", "path", "Date Last Modified")
.Font.Bold = True
End With
Set cl = ws.Cells(2, 1)
ListFolders cl, objFSO.GetFolder(objFolderName)
Set objFSO = Nothing
End Sub
Sub ListFolders(rng As Range, Fol As Scripting.Folder)
Dim SubFol As Scripting.Folder
Dim FileItem As Scripting.File
' List Files
For Each FileItem In Fol.Files
rng.Cells(1, 1) = FileItem.Name
rng.Cells(1, 2) = FileItem.ParentFolder.Path
rng.Cells(1, 3) = FileItem.DateLastModified
Set rng = rng.Offset(1, 0)
Next
' Proces subfolders
For Each SubFol In Fol.SubFolders
ListFolders rng, SubFol
Next
With ActiveSheet
.Columns.EntireColumn.AutoFit
End With
End Sub
I am posting another update which is not cell by cell filling. REVISED UPDATE ON 3-09-2015
Sub GetFileList()
Dim strFolder As String
Dim objFSO As Object
Dim objFolder As Object
Dim myResults As Variant
Dim lCount As Long
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Get the directory from the user
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then Exit Sub
'user cancelled
strFolder = .SelectedItems(1)
End With
Set objFolder = objFSO.GetFolder(strFolder)
'the variable dimension has to be the second one
ReDim myResults(0 To 5, 0 To 0)
' place make some headers in the array
myResults(0, 0) = "Filename"
myResults(1, 0) = "Size"
myResults(2, 0) = "Created"
myResults(3, 0) = "Modified"
myResults(4, 0) = "Accessed"
myResults(5, 0) = "Full path"
'Send the folder to the recursive function
FillFileList objFolder, myResults, lCount
' Dump these to a worksheet
fcnDumpToWorksheet myResults
'tidy up
Set objFSO = Nothing
End Sub
Private Sub FillFileList(objFolder As Object, ByRef myResults As Variant, ByRef lCount As Long, Optional strFilter As String)
Dim i As Integer
Dim objFile As Object
Dim fsoSubFolder As Object
Dim fsoSubFolders As Object
'load the array with all the files
For Each objFile In objFolder.Files
lCount = lCount + 1
ReDim Preserve myResults(0 To 5, 0 To lCount)
myResults(0, lCount) = objFile.Name
myResults(1, lCount) = objFile.Size
myResults(2, lCount) = objFile.DateCreated
myResults(3, lCount) = objFile.DateLastModified
myResults(4, lCount) = objFile.DateLastAccessed
myResults(5, lCount) = objFile.Path
Next objFile
'recursively call this function with any subfolders
Set fsoSubFolders = objFolder.SubFolders
For Each fsoSubFolder In fsoSubFolders
FillFileList fsoSubFolder, myResults, lCount
Next fsoSubFolder
End Sub
Private Sub fcnDumpToWorksheet(varData As Variant, Optional mySh As Worksheet)
Dim iSheetsInNew As Integer
Dim sh As Worksheet, wb As Workbook
Dim myColumnHeaders() As String
Dim l As Long, NoOfRows As Long
If mySh Is Nothing Then
'make a workbook if we didn't get a worksheet
iSheetsInNew = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set wb = Application.Workbooks.Add
Application.SheetsInNewWorkbook = iSheetsInNew
Set sh = wb.Sheets(1)
Else
Set mySh = sh
End If
'since we switched the array dimensions, have to transpose
With sh
Range(.Cells(1, 1), .Cells(UBound(varData, 2) + 1, UBound(varData, 1) + 1)) = _
Application.WorksheetFunction.Transpose(varData)
.UsedRange.Columns.AutoFit
End With
Set sh = Nothing
Set wb = Nothing
End Sub
