CODEWITHSUNDEEP
vbaexcel
arka dutta
arka dutta

Reputation: 21

VBA-List various filenames from folders and subfolders based on different strings

I am trying to list all the files from a folder and subfolder(s) based on a string from a userform into a new workbook. For eg. I am want to input the string as 0200-T1;0201-T12 and I am splitting the string using ";" to search for two or more files which begin with the respective strings. Please have a look at my code and suggest corrections. Currently it only lists the first string from the split array.

Sub ListFilesHomolog()
xdir = Usrfrm_JbOrderFiles.Txtbx_Browse2.Value ' define search path
Set mywb = Workbooks.Add
Call ListFilesInFolderHomolog(xdir, True)
End Sub

Sub ListFilesInFolderHomolog(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Dim rowIndex As Long
Application.ScreenUpdating = False
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
On Error GoTo 0
rowIndex = Application.ActiveSheet.Range("A1048576").End(xlUp).Row + 1
    For Each xFile In xFolder.Files
        On Error Resume Next
            fname = xFile.Name
          HomFiles = Split(Usrfrm_JbOrderFiles.txtbx_jbOrdNo2.Value, ";")
          For scount = LBound(HomFiles) To UBound(HomFiles)
            srchTrm = HomFiles(scount) 'value from form
            tst = Split(fname, "-")

            If InStr(UCase(tst(0) & "-" & tst(1)), UCase(srchTrm)) = 0 Then GoTo a: 'skip if string not found
            With mywb
                mywb.Activate
                Worksheets(1).Columns("A:H").FormatConditions.Add Type:=xlExpression, Formula1:="=E($A1<>"""";MOD(LIN();2))"
                Worksheets(1).Columns("A:H").FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
                    With Worksheets(1).Columns("A:H").FormatConditions(1).Interior
                        .PatternColorIndex = xlAutomatic
                        .ThemeColor = xlThemeColorDark1
                        .TintAndShade = -4.99893185216834E-02
                    End With
                Worksheets(1).Columns("A:H").FormatConditions(1).StopIfTrue = False

                Worksheets(1).Cells(1, 1).Value = "File Name" 'file name"
                Worksheets(1).Cells(1, 8).Value = "Link" 'file name"
                Worksheets(1).Cells(rowIndex, 1).Formula = xFile.Name 'file name
                ActiveSheet.Hyperlinks.Add Cells(rowIndex, 8), xFile, TextToDisplay:="Open"
                Worksheets(1).Cells.EntireColumn.AutoFit
                ActiveWindow.DisplayGridlines = False
                ActiveWindow.DisplayHeadings = False
            End With
                rowIndex = rowIndex + 1
            Next scount
a:
    Next xFile
If xIsSubfolders Then
    For Each xSubFolder In xFolder.SubFolders
        ListFilesInFolderHomolog xSubFolder.Path, True
    Next xSubFolder
End If
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
Application.ScreenUpdating = True
End Sub

Upvotes: 1

Views: 167

Answers (1)

YowE3K
YowE3K

Reputation: 23974

You currently exit from your For scount loop if the file being looked at does not match the first criteria.

Using your example criteria of "0200-T1;0201-T12", if the filename does not contain the string "0200-T1" you exit the loop and never check to see if the filename contains the string "0201-T12".

You need to change

        Next scount
a:
    Next xFile

to be

a:
        Next scount
    Next xFile

Upvotes: 1

Related Questions