VBA: Multiple OR conditions in single InStr?-CodePudding

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

CodePudding user response：

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

CodePudding user response：

Maybe push out the check into a separate function, so you can do this in the main code:

'...
If Not SkipFolder(sf.Name) Then colFolders.Add sf
'...

Function:

Function SkipFolder(folderName)
    Dim v
    For Each v In Array("STAG", "STAP", "XXX") 'etc etc
        If InStr(1, folderName, v, vbTextCompare) > 0 Then
            SkipFolder = True
            Exit Function
        End If
    Next v
End Function

CodePudding user response：

Another approach is to use Regular Expressions. In the .Pattern you would add your exclusions separated by the pipe symbol |.

' Library Reference: Microsoft VBScript Regular Expressions 5.5
With New RegExp
    .IgnoreCase = True
    .Pattern = "STAG|STAP"
    
    For Each sf In oFolder.SubFolder
        If Not .test(sf) Then
            colFolders.Add sf
        End If
    Next
End With