VBA Help - List only File Names from Criteria and Specific File Type

[johnny51981]

Hello:
I plagiarized the following VBA from a YouTube video that I found, and it gives me exactly what I am needing...however it is missing a piece that I hope can be solved here. I would appreciate any help, and please know...I am not very strong in VBA (yet).

I am needing to augment this code to only return file names that contain the words "WORK ORDER" and that are saved as a PDF file type.

Option Explicit
Sub ListAllFiles()
    
    ThisWorkbook.Sheets("Files").Select
            
    Call ClearList
    
    Dim objFSO As Scripting.FileSystemObject
    Dim objFolder As Scripting.Folder
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(Range("NTPFolder"))
    
    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, 2) = objFile.Path
    Cells(nextRow, 3) = objFile.Size
    Cells(nextRow, 4) = objFile.Type
    Cells(nextRow, 5) = objFile.Attributes
    nextRow = nextRow + 1
Next

For Each objSubFolder In objFolder.SubFolders
    Call GetFileDetails(objSubFolder)
Next

End Function
Sub ClearList()
'
' ClearList Macro
'

'
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range("A2:E2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("A2").Select
End Sub

 

[JoeMo]

Untested,but you can try this modification:

For Each objFile In objFolder.Files
    If objFile.Name Like "*WORK ORDER*" & LCase(Right(objFile.Name, 4)) = ".pdf" Then
        Cells(nextRow, 1) = objFile.Name
        Cells(nextRow, 2) = objFile.Path
        Cells(nextRow, 3) = objFile.Size
        Cells(nextRow, 4) = objFile.Type
        Cells(nextRow, 5) = objFile.Attributes
        nextRow = nextRow + 1
    End If
Next

 

[JEC]

Try this code. You only need to change the path to yours

Dim ar() As Variant, x As Long

Public Sub file_search()
 getFile "C:\Users\xxx\xxx\xxx\"          'change this to your path
 Range("L2").Resize(x, 5) = Application.Transpose(ar)
 End
End Sub

Public Sub getFile(objFolderPath As String)
 Dim sFold, it, sf
 With CreateObject("scripting.filesystemobject")
    Set sFold = .GetFolder(objFolderPath)
    For Each it In sFold.Files
       If LCase(.GetExtensionName(it)) = "pdf" And InStr(it.Name, "WORK ORDER") Then
          ReDim Preserve ar(4, x)
          ar(0, x) = it.Name
          ar(1, x) = it.Path
          ar(2, x) = it.Size
          ar(3, x) = it.Type
          ar(4, x) = it.Attributes
          x = x + 1
       End If
    Next
    For Each sf In sFold.SubFolders
       getFile sf.Path
    Next
 End With
End Sub

 

[johnny51981]

Untested,but you can try this modification:

For Each objFile In objFolder.Files
    If objFile.Name Like "*WORK ORDER*" & LCase(Right(objFile.Name, 4)) = ".pdf" Then
        Cells(nextRow, 1) = objFile.Name
        Cells(nextRow, 2) = objFile.Path
        Cells(nextRow, 3) = objFile.Size
        Cells(nextRow, 4) = objFile.Type
        Cells(nextRow, 5) = objFile.Attributes
        nextRow = nextRow + 1
    End If
Next

This works with one tiny change, instead of using "&", I changed it to "And", which gave me the result I was looking for. Appreciate it!

 

[johnny51981]

Untested,but you can try this modification:

For Each objFile In objFolder.Files
    If objFile.Name Like "*WORK ORDER*" & LCase(Right(objFile.Name, 4)) = ".pdf" Then
        Cells(nextRow, 1) = objFile.Name
        Cells(nextRow, 2) = objFile.Path
        Cells(nextRow, 3) = objFile.Size
        Cells(nextRow, 4) = objFile.Type
        Cells(nextRow, 5) = objFile.Attributes
        nextRow = nextRow + 1
    End If
Next

Any idea on how to exclude a specific Sub Folder?

 

[JoeMo]

This works with one tiny change, instead of using "&", I changed it to "And", which gave me the result I was looking for. Appreciate it!

You are welcome - thanks for the reply.

 

[JoeMo]

Any idea on how to exclude a specific Sub Folder?

Again untested, but maybe something like this modification:

For Each objSubFolder In objFolder.SubFolders
    If objSubFolder.Name <> "Specific SubFolder Name here" Then
        Call GetFileDetails(objSubFolder)
    End If
Next

 

[johnny51981]

Again untested, but maybe something like this modification:

For Each objSubFolder In objFolder.SubFolders
    If objSubFolder.Name <> "Specific SubFolder Name here" Then
        Call GetFileDetails(objSubFolder)
    End If
Next

This appears to be successful on my end. Thank you again!!!

 

[JoeMo]

This appears to be successful on my end. Thank you again!!!

You are welcome- thanks for the reply.

 

[JEC]

Thanks for answering too