Vba- file

[jill2steenb]

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

 

[jill2steenb]

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!