excelvbainstr

VBA: Multiple OR conditions in single InStr?


Is there an efficient way to have a single InStr have a list of expressions sought?

The segment of my code in question:

For Each sf In oFolder.SubFolders
    If InStr(1, sf, "STAG", vbTextCompare) Or InStr(1, sf, "STAP", vbTextCompare) Then
    Else
        colFolders.Add sf
    End If
Next sf

I'm using this to gather a collection of all files within the folders and subfolders of a directory. There are possibly hundreds of folders in question and there are a few repeating folder names that I want to just skip. My macro is working and doing exactly what I want it to (finally). And I can use the mentioned InStr to skip subfolders with the specified name. But there is a list of about a dozen recurring names, and it seems like it would be very inefficient to have a dozen InStr items in my IF statement. I feel like there's got to be a better way, but my amateur knowledge is lacking and doesn't even know what to begin searching for.

My complete code, in case it's needed:

Sub GetFilesCol()
    Application.ScreenUpdating = False
    
    Dim ofso As Scripting.FileSystemObject
    Dim oFolder As Object
    Dim oFile As Object
    Dim i As Long, colFolders As New Collection, ws As Worksheet
 
    Set ws = Sheets.Add(Type:=xlWorksheet, After:=ActiveSheet)
    Set ofso = CreateObject("Scripting.FileSystemObject")
    Set oFolder = ofso.GetFolder("F:\TestDirectory")
    
    'Keeping On Error Resume Next only temporarily while I test and make sure everything else is working
    On Error Resume Next
           
    ws.Cells(1, 1) = "File Name"
    ws.Cells(1, 2) = "File Type"
    ws.Cells(1, 3) = "Date Created"
    ws.Cells(1, 4) = "Date Last Modified"
    ws.Cells(1, 5) = "Date Last Accessed"
    ws.Cells(1, 6) = "File Path"
    
    Rows(1).Font.Bold = True
    Rows(1).Font.Size = 11
    Rows(1).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
    Range("C:E").Columns.AutoFit
           
    colFolders.Add oFolder          'start with this folder
    
    Do While colFolders.Count > 0      'process all folders
        Set oFolder = colFolders(1)    'get a folder to process
        colFolders.Remove 1            'remove item at index 1
                    
        For Each oFile In oFolder.Files
            
                ws.Cells(i + 2, 1) = oFile.Name
                ws.Cells(i + 2, 2) = oFile.Type
                ws.Cells(i + 2, 3) = oFile.DateCreated
                ws.Cells(i + 2, 4) = oFile.DateLastModified
                ws.Cells(i + 2, 5) = oFile.DateLastAccessed
                ws.Cells(i + 2, 6) = oFolder.Path
                i = i + 1
            
        Next oFile

        'add any subfolders to the collection for processing
        For Each sf In oFolder.SubFolders
            If InStr(1, sf, "STAG", vbTextCompare) Or InStr(1, sf, "STAP", vbTextCompare) Then
            Else
                colFolders.Add sf
            End If
        Next sf
           
    Loop

    Application.ScreenUpdating = True
    
End Sub

Solution

  • You can add all the specific names to an array and then iterate the array. Something like this:

    Dim canAdd As Boolean
    Dim arrExclude() As Variant
    Dim v As Variant
    
    arrExclude = Array("STAG", "STAP") 'Add as many names as needed
    For Each sf In oFolder.SubFolders
        canAdd = True
        For Each v In arrExclude
            If InStr(1, sf, v, vbTextCompare) > 0 Then
                canAdd = False
                Exit For
            End If
        Next v
        If canAdd Then colFolders.Add sf
    Next sf