Enhancement for folder/file/subfolder lookup automation

rawr19911

Board Regular
Joined
Jan 21, 2020
Messages
91
Office Version
  1. 2016
the code i am using is below- the only issues I'm having and i can't figure it out is these things
1) the code is bringing in deleted files it does put a ~ infront of it which is nice i can filter it out but is there a way to just not show them
2) the file is bringing in i think its hidden files or something- its extensions i never even heard of - i only need the files that are truly files such as one note excel, word etc. some of the files are like .DB which i guess is data base files but its not an actual file i am not sure of what it is
3) nice to have not needed: not sure if possible but is there a way to add additional locations or do they have to be each their individual pull if it does have to be individual pulls I'm okay with that just takes longer -
example if i need to pull everything from examplepath and examplepath2 and examplepath3


thanks,

Sub AllFileFolder()
Dim strPath As String
Dim sht As Worksheet
Dim rng As Range
Dim Path As String
Dim fso As Object
Dim fld As Object
Dim fil As Object

strPath = "C:\Users\User\Documents"

Set sht = ActiveWorkbook.Worksheets.Add

Set rng = sht.Cells(1, 1)
rng.Resize(, 5).Value = Array("FileName", "FileLocation", "Extension", "CreationDate", "LastAccessDate", "LastModficationDate")

Set fso = CreateObject("Scripting.FileSystemObject")

Set fld = fso.GetFolder(strPath)

getFilesFromFolder fld, rng

MsgBox "Done", vbOKOnly + vbInformation, "Done"
End Sub
Private Sub getFilesFromFolder(fld As Object, rng As Range)
Dim subfld As Object
Dim fil As Object

On Error GoTo ErrHandler

For Each fil In fld.Files

DoEvents

Set rng = rng.Offset(1)

With rng
.Cells(, 1).Value = fil.Name
.Cells(, 2).Value = fld.Path
.Cells(, 3).Value = Right(fil.Name, Len(fil.Name) - InStrRev(fil.Name, "."))
.Cells(, 4).Value = fil.DateCreated
.Cells(, 5).Value = fil.DateLastAccessed
.Cells(, 6).Value = fil.DateLastModified
End With
Next fil


For Each subfld In fld.SubFolders

getFilesFromFolder subfld, rng
Next subfld
ErrHandler:

End Sub
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Good to hear you got the solution.
If you would like to post the solution then it is perfectly fine to mark your post as the solution to help future readers. Otherwise, please do not mark a post that doesn't contain a solution.
 
Upvote 0
@Fluff sorry about that hope you are having a great morning-

the solution we have- is a work around to just filter the items not needed out- nothing special
 
Upvote 0

Forum statistics

Threads
1,223,904
Messages
6,175,295
Members
452,632
Latest member
jladair

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top