VBA code not executing and excel have to be shut down by endtask

[Mughees]

Hi everyone,

There is a vba code which I developed in order to list down the details of all the files present in a particular folder/subfolder. Below is the code:




Option Explicit

Sub listallfiles()

Dim objfso As Scripting.FileSystemObject
Dim objfolder As Scripting.Folder

Set objfso = CreateObject("scripting.filesystemobject")
Set objfolder = objfso.GetFolder("E:\data\2019 data")

Call getfiledetails(objfolder)

End Sub


Function getfiledetails(objfolder As Scripting.Folder)

Dim objfile As Scripting.File
Dim nextrow As Long
Dim objsubfolder As Scripting.Folder

nextrow = Cells(Rows.Count, 1).End(xlUp).Row + 1
For Each objfile In objfolder.Files
Cells(nextrow, 1) = objfile.Name
Cells(nextrow, 5) = objfile.DateCreated
nextrow = nextrow + 1
Next

For Each objsubfolder In objfolder.SubFolders
Call getfiledetails(objsubfolder)

Next

End Function


The end result is nearly 8000-9000 rows. However, the code is most of the time unresponsive. I have to make 5-6 fail attempt before it actually gets executed. I do know that it can take 5-10 mins or a little more. However, despite leaving my laptop free to let it execute this code, it is still not doing working properly.

Can anyone please help in adjusting that code so that I can get results all of the time in a proper manner and in short time period ?

Thanks and Regards
Mughees

[Dave]

Hi Mughees and Welcome to this forum. This seems to work. HTH. Dave

Option Explicit

Sub listallfiles()
Dim objfso As Object
Dim objfolder As Object
Dim objsubfolder As Object
Set objfso = CreateObject("scripting.filesystemobject")
Set objfolder = objfso.GetFolder("C:\YourFolderName")

Call getfiledetails(objfolder)
For Each objsubfolder In objfolder.SubFolders
Call getfiledetails(objsubfolder)
Next
Set objsubfolder = Nothing
Set objfolder = Nothing
Set objfso = Nothing
End Sub


Function getfiledetails(objfolder As Object)
Dim objfile As Object
Dim nextrow As Long
With Sheets("sheet1")
nextrow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
For Each objfile In objfolder.Files
.Cells(nextrow, 1) = objfile.Name
.Cells(nextrow, 5) = objfile.DateCreated
nextrow = nextrow + 1
Next
End With
Set objfile = Nothing
End Function

[Mughees]

Hi Mughees and Welcome to this forum. This seems to work. HTH. Dave

Option Explicit

Sub listallfiles()
Dim objfso As Object
Dim objfolder As Object
Dim objsubfolder As Object
Set objfso = CreateObject("scripting.filesystemobject")
Set objfolder = objfso.GetFolder("C:\YourFolderName")

Call getfiledetails(objfolder)
For Each objsubfolder In objfolder.SubFolders
Call getfiledetails(objsubfolder)
Next
Set objsubfolder = Nothing
Set objfolder = Nothing
Set objfso = Nothing
End Sub


Function getfiledetails(objfolder As Object)
Dim objfile As Object
Dim nextrow As Long
With Sheets("sheet1")
nextrow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
For Each objfile In objfolder.Files
.Cells(nextrow, 1) = objfile.Name
.Cells(nextrow, 5) = objfile.DateCreated
nextrow = nextrow + 1
Next
End With
Set objfile = Nothing
End Function


Thank you for your response but the code is still not working properly. After changing the sheet name and folder name, I ran this code. However, only 94 rows got downloaded. The rest of the data is still missing. I am pasting my edited code for reference.

Option Explicit

Sub listallfiles()
Dim objfso As Object
Dim objfolder As Object
Dim objsubfolder As Object
Set objfso = CreateObject("scripting.filesystemobject")
Set objfolder = objfso.GetFolder("E:\data\2019 data")

Call getfiledetails(objfolder)
For Each objsubfolder In objfolder.SubFolders
Call getfiledetails(objsubfolder)
Next
Set objsubfolder = Nothing
Set objfolder = Nothing
Set objfso = Nothing


End Sub


Function getfiledetails(objfolder As Object)
Dim objfile As Object
Dim nextrow As Long
With Sheets("information")
nextrow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
For Each objfile In objfolder.Files
.Cells(nextrow, 1) = objfile.Name
.Cells(nextrow, 5) = objfile.DateCreated
nextrow = nextrow + 1
Next
End With
Set objfile = Nothing


End Function

[Dave]

Why only 94? Do you have subfolders in subfolders? Dave

[Dave]

Trial 2....

Option Explicit

Sub listallfiles()
Dim objfso As Object, objfolder As Object
Set objfso = CreateObject("scripting.filesystemobject")
Set objfolder = objfso.GetFolder("C:\YourFolderName")
Call getfiledetails(objfolder)
Set objfolder = Nothing
Set objfso = Nothing
End Sub


Function getfiledetails(objfolder As Object)
Dim objfile As Object, nextrow As Long, objsubfolder As Object
With Sheets("sheet1")
nextrow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
For Each objfile In objfolder.Files
.Cells(nextrow, 1) = objfile.Name
.Cells(nextrow, 5) = objfile.DateCreated
nextrow = nextrow + 1
Next
End With
For Each objsubfolder In objfolder.SubFolders
Call getfiledetails(objsubfolder)
Next
Set objsubfolder = Nothing
Set objfile = Nothing
End Function
Dave