VBA-根据不同的字符串列出来自文件夹和子文件夹的各种文件名

我想从一个文件夹和子文件夹（s）中基于从用户表单的字符串列出所有文件到一个新的工作簿。例如。我想输入字符串为0200-T1; 0201-T12，我用“;”分割字符串搜索以各个字符串开头的两个或多个文件。请查看我的代码并提出更正建议。目前它只列出拆分数组中的第一个字符串。VBA-根据不同的字符串列出来自文件夹和子文件夹的各种文件名

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

来源

2017-01-30 arka dutta

您目前从For scount循环退出如果该文件正在看着不符合第一准则。

使用的"0200-T1;0201-T12"你的榜样标准，如果文件名不包含"0200-T1"退出循环，永不检查，看看如果文件名包含字符串"0201-T12"的字符串。

您需要更改

 Next scount 
a: 
    Next xFile

是

a: 
     Next scount 
    Next xFile

来源

2017-01-30 18:49:26 YowE3K

谢谢您的帮助，我会尝试了这一点。还有一个疑问是，我如何知道上面代码中循环的最后一次迭代（最后一个xFile或最后一个子文件夹）？ –

@arkadutta - 为什么你需要知道什么时候是最后一次迭代？通常（但是，但是，并不总是）需要在“最后”迭代中完成的任何事情实际上可以在最后一次迭代结束后完成，即在循环之外，所以我只是想知道你有什么问题只能是通过执行最后一次循环内部的东西解决。 – YowE3K

可能是我无法说清楚，我需要在最后一次迭代后执行某些操作，但不知何故，我无法找到循环结束。 –

VBA-根据不同的字符串列出来自文件夹和子文件夹的各种文件名

回答

相关问题