Consulting

Results 1 to 5 of 5

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

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    VBAX Newbie
    Joined
    Dec 2019
    Posts
    2
    Location

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

    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
    Last edited by Paul_Hossler; 03-23-2020 at 05:30 AM. Reason: Added CODE tags

  2. #2
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    696
    Location
    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

  3. #3
    VBAX Newbie
    Joined
    Dec 2019
    Posts
    2
    Location

    Isn t working

    Quote Originally Posted by Dave View Post
    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

  4. #4
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    696
    Location
    Why only 94? Do you have subfolders in subfolders? Dave

  5. #5
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    696
    Location
    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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •