Vba- file

jill2steenb

New Member
Joined
Oct 11, 2017
Messages
2
I am trying to list all the files within a specific directory and it's subdirectories. The following code is working for that.
However, I want to only get .png & .pdf files listed. I also want to skip specific folders, either that contains a word or is listed in specific cells.


Sub GetFolder()​
If MsgBox("This will take awile! Continue?", vbYesNo) = vbNo Then Exit Sub​
Sheets("DATA Folders").Select​
Range("A1").Select​
Range("A:L").ClearContents​
Range("A1").Value = "Name"​
'Range("B1").Value = "Path"​
'Range("C1").Value = "Size (KB)"​
'Range("D1").Value = "DateLastModified"​
'Range("E1").Value = "Attributes"​
Range("F1").Value = "DateCreated"​
'Range("G1").Value = "DateLastAccessed"​
'Range("H1").Value = "Drive"​
Range("I1").Value = "ParentFolder"​
'Range("J1").Value = "ShortName"​
'Range("K1").Value = "ShortPath"​
Range("L1").Value = "Type"​
Range("A1").Select​

Dim strPath As String​
strPath = "T:\1 - SKIDS"​

Dim OBJ As Object, folder As Object, file As Object​

Set OBJ = CreateObject("Scripting.FileSystemObject")​
Set folder = OBJ.GetFolder(strPath)​
Call ListFiles(folder)​

Dim SubFolder As Object​

For Each SubFolder In folder.SubFolders​

Call ListFiles(SubFolder)​
Call GetSubFolders(SubFolder)​
Next SubFolder​

Range("A1").Select​
End Sub​

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''​

Sub ListFiles(ByRef folder As Object)​
For Each file In folder.Files​
ActiveCell.Offset(1, 0).Select​
ActiveCell = file.Name​
'ActiveCell.Offset(0, 1) = file.Path​
'ActiveCell.Offset(0, 2) = (file.Size / 1024) 'IN KB​
'ActiveCell.Offset(0, 3) = file.DateLastModified​
'ActiveCell.Offset(0, 4) = file.Attributes​
ActiveCell.Offset(0, 5) = file.DateCreated​
'ActiveCell.Offset(0, 6) = file.DateLastAccessed​
'ActiveCell.Offset(0, 7) = file.Drive​
ActiveCell.Offset(0, 8) = file.ParentFolder​
'ActiveCell.Offset(0, 9) = file.ShortName​
'ActiveCell.Offset(0, 10) = file.ShortPath​
ActiveCell.Offset(0, 11) = file.Type​
Next file​

End Sub​

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''​

Sub GetSubFolders(ByRef SubFolder As Object)​

Dim FolderItem As Object​

For Each FolderItem In SubFolder.SubFolders​
Call ListFiles(FolderItem)​
Call GetSubFolders(FolderItem)​
Next FolderItem​

End Sub​


Could someone help me tweek what i have?? I'm newer to code, but I know enough to cut/paste and modify for my specific folders.

Edit: oh, And the only info I would need for sure is the filename and path. All the others shown are just optional.

Thanks!
JIll
 
Last edited by a moderator:

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
I think finally got it!


Sub GetFolder()
If MsgBox("This will take awhile! Continue?", vbYesNo) = vbNo Then Exit Sub
Sheets("DATA Folders").Select
Range("A1").Select
Range("A:L").ClearContents
Range("A1").Value = "Name"
'Range("B1").Value = "Path"
'Range("C1").Value = "Size (KB)"
'Range("D1").Value = "DateLastModified"
'Range("E1").Value = "Attributes"
Range("F1").Value = "DateCreated"
'Range("G1").Value = "DateLastAccessed"
'Range("H1").Value = "Drive"
Range("I1").Value = "ParentFolder"
'Range("J1").Value = "ShortName"
'Range("K1").Value = "ShortPath"
Range("L1").Value = "Type"
Range("A1").Select


Dim strPath As String
strPath = "T:"


Dim OBJ As Object, folder As Object, file As Object


Set OBJ = CreateObject("Scripting.FileSystemObject")
Set folder = OBJ.GetFolder(strPath)


Call ListFiles(folder)
Dim SubFolder As Object


For Each SubFolder In folder.SubFolders
If SubFolder Like "*archive*" _
Or SubFolder Like "*Batch*" _
Or SubFolder Like "*INFO*" _
Or SubFolder Like "*old*" _
Or SubFolder Like "*Assembly*" _
Or SubFolder Like "*TEST*" _
Or SubFolder Like "*File Copy Update*" Then
'DO NOTHING
Else
Call ListFiles(SubFolder)
Call GetSubFolders(SubFolder)
End If
Next SubFolder


Range("A1").Select
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Sub ListFiles(ByRef folder As Object)
For Each file In folder.Files
' Check extension of each file in folder.
If Right(file.Name, 4) = ".png" Or Right(file.Name, 4) = ".pdf" Then




ActiveCell.Offset(1, 0).Select
ActiveCell = file.Name
'ActiveCell.Offset(0, 1) = file.Path
'ActiveCell.Offset(0, 2) = (file.Size / 1024) 'IN KB
'ActiveCell.Offset(0, 3) = file.DateLastModified
'ActiveCell.Offset(0, 4) = file.Attributes
ActiveCell.Offset(0, 5) = file.DateCreated
'ActiveCell.Offset(0, 6) = file.DateLastAccessed
'ActiveCell.Offset(0, 7) = file.Drive
ActiveCell.Offset(0, 8) = file.ParentFolder
'ActiveCell.Offset(0, 9) = file.ShortName
'ActiveCell.Offset(0, 10) = file.ShortPath
ActiveCell.Offset(0, 11) = file.Type
End If


Next file


End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Sub GetSubFolders(ByRef SubFolder As Object)
' Check name in file in folder.
If SubFolder Like "*archive*" _
Or SubFolder Like "*Batch*" _
Or SubFolder Like "*INFO*" _
Or SubFolder Like "*old*" _
Or SubFolder Like "*Assembly*" _
Or SubFolder Like "*TEST*" _
Or SubFolder Like "*File Copy Update*" Then
Exit Sub
End If
Dim FolderItem As Object


For Each FolderItem In SubFolder.SubFolders
If FolderItem Like "*archive*" _
Or FolderItem Like "*Batch*" _
Or FolderItem Like "*INFO*" _
Or FolderItem Like "*old*" _
Or FolderItem Like "*Assembly*" _
Or FolderItem Like "*TEST*" _
Or FolderItem Like "*File Copy Update*" Then
'DO NOTHING
Else
Call ListFiles(FolderItem)
Call GetSubFolders(FolderItem)
End If
Next FolderItem


End Sub


thanks for any feedback or a way to simplify! thanks!
 
Upvote 0

Forum statistics

Threads
1,223,896
Messages
6,175,259
Members
452,626
Latest member
huntinghunter

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