VBA to List items (including folders) with specific word

[darkhangelsk]

Hello,

I would like to ask if there's a way for VBA to list all files (including folders) with word OLDIES_(whatever the text or number here)

Similar to this but with additional column to put location and extension.

Sub Example4()

Dim varDirectory As Variant
Dim flag As Boolean
Dim i As Integer
Dim strDirectory As String

strDirectory = "C:\Desktop"
i = 1
flag = True
varDirectory = Dir(strDirectory, vbDirectory)

While flag = True
    If varDirectory = "" Then
        flag = False
    Else
        Cells(i + 1, 1) = varDirectory
        Cells(i + 1, 2) = strDirectory + varDirectory
        'returns the next file or directory in the path
        varDirectory = Dir
        i = i + 1
    End If

Wend
End Sub

Column will be like this (comma will be next tab):

Name, Location, extension (if folder then just folder)
OLDIES_12345, C:Desktop, Folder
OLDER_23456, C:Desktop, .zip
OLDER_23457, C:Desktop, .xls

Thank you!

 

[NdNoviceHlp]

Hi darkhangelsk. You can trial this. HTH. Dave

Sub ListOLDIES()
Dim FSO As Object, FSOSubFolder As Object, FileName As String
Dim FSOFile As Object, objFolder As Object, RowNum As Integer
Dim ExtSplit As Variant, NameSplit As Variant
strDirectory = "C:\Desktop\"
RowNum = 1
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.GetFolder(strDirectory)
For Each FSOSubFolder In objFolder.subfolders
    ListOLDIES
Next FSOSubFolder

For Each FSOFile In objFolder.Files
If InStr(FSOFile.path, "OLDIES") Then
ExtSplit = Split(FSOFile.path, ".")
NameSplit = Split(FSOFile.path, "\")
FileName = Left(NameSplit(UBound(NameSplit)), _
           Len(NameSplit(UBound(NameSplit))) - Len(ExtSplit(UBound(ExtSplit))) - 1)
Flpath = Left(FSOFile.path, Len(FSOFile.path) - Len(NameSplit(UBound(NameSplit))))
ActiveSheet.Cells(RowNum, 1) = FileName & ", " & Flpath & ", ." & ExtSplit(UBound(ExtSplit))
RowNum = RowNum + 1
End If
Next FSOFile
Set objFolder = Nothing
Set FSO = Nothing
End Sub

 

[darkhangelsk]

Hi darkhangelsk. You can trial this. HTH. Dave

Sub ListOLDIES()
Dim FSO As Object, FSOSubFolder As Object, FileName As String
Dim FSOFile As Object, objFolder As Object, RowNum As Integer
Dim ExtSplit As Variant, NameSplit As Variant
strDirectory = "C:\Desktop\"
RowNum = 1
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.GetFolder(strDirectory)
For Each FSOSubFolder In objFolder.subfolders
    ListOLDIES
Next FSOSubFolder

For Each FSOFile In objFolder.Files
If InStr(FSOFile.path, "OLDIES") Then
ExtSplit = Split(FSOFile.path, ".")
NameSplit = Split(FSOFile.path, "\")
FileName = Left(NameSplit(UBound(NameSplit)), _
           Len(NameSplit(UBound(NameSplit))) - Len(ExtSplit(UBound(ExtSplit))) - 1)
Flpath = Left(FSOFile.path, Len(FSOFile.path) - Len(NameSplit(UBound(NameSplit))))
ActiveSheet.Cells(RowNum, 1) = FileName & ", " & Flpath & ", ." & ExtSplit(UBound(ExtSplit))
RowNum = RowNum + 1
End If
Next FSOFile
Set objFolder = Nothing
Set FSO = Nothing
End Sub

Thanks for replying. I tried this but i got an error of "Out of stack space". I was also thinking if this will work with subfolders. Again, thank you, will try to research how to remove the error as well.

 

[NdNoviceHlp]

Whoops! My bad. It did work with my limited testing however I can generate the same error... it's due to the recursive subfolder search. If you take the subfolder search out then all is well. I can't seem to get the subfolder part to work? Maybe others can help if it's needed for your outcome. Dave

Sub ListOLDIES()
Dim FSO As Object, FSOSubFolder As Object, FileName As String
Dim FSOFile As Object, objFolder As Object, RowNum As Integer
Dim strDirectory As String, ExtSplit As Variant, NameSplit As Variant
strDirectory = "C:\Desktop\"
RowNum = 1
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.GetFolder(strDirectory)
above:
For Each FSOFile In objFolder.Files
If InStr(FSOFile.path, "OLDIES") Then
ExtSplit = Split(FSOFile.path, ".")
NameSplit = Split(FSOFile.path, "\")
FileName = Left(NameSplit(UBound(NameSplit)), _
           Len(NameSplit(UBound(NameSplit))) - Len(ExtSplit(UBound(ExtSplit))) - 1)
Flpath = Left(FSOFile.path, Len(FSOFile.path) - Len(NameSplit(UBound(NameSplit))))
ActiveSheet.Cells(RowNum, 1) = FileName & ", " & Flpath & ", ." & ExtSplit(UBound(ExtSplit))
RowNum = RowNum + 1
End If
Next FSOFile
Set objFolder = Nothing
Set FSO = Nothing
End Sub