如果有select循环通过excel vba中的目录，哪个是最好的方法

IO要检查path主目录/ ABC * / Y / XY * / *。edf中的所有edf文件，然后检查文件中是否有特定的短语，如果find，请检查另一个短语等等，然后将数据填入电子表格。 我试图通过三种方法来实现这一目标，但是在每种方法中都被卡住了。 是否有可能你们中的任何一个人通过代码，告诉我哪里错了，哪个是最好的方法。 正如我以前的问题所产生的错误观念，我不希望任何人为我写代码。 我已经开始了三天vba的工作，并有五天的时间来完成这个项目。 这就是为什么我会很感激，如果任何人都可以看看，并告诉我我要去哪里错了。

方法1通过简单的目录命令在这第一循环FCS *工作很好，但第二个循环根本不工作，并在第一次迭代给运行时错误。 我知道这不是一个好方法，但在其他情况下不起作用。

Sub Iterate_Folders() Dim ctr As Integer Dim ctr1 As Integer ctr = 1 ctr1 = 1 Paths = "C:\Users\sobiakanwal\Downloads\QSHWRA\QSHWRA\ " ' Path should always contain a '\' at end FirstDir = Dir(Paths, vbDirectory) ' Retrieving the first entry. Do Until FirstDir = "" ' Start the loop. If (FirstDir Like "FCS*") Then ActiveSheet.Cells(ctr, 15).Value = Paths & FirstDir Path1 = Paths & FirstDir & "\FUNCTION_BLOCK\DR*" ActiveSheet.Cells(ctr, 20).Value = Path1 'ActiveSheet.Cells(ctr, 25).Value = SecondDir SecondDir = Dir(Path1, vbDirectory) Do While SecondDir = "" ActiveSheet.Cells(ctr, 30).Value = "Hi" If (True) Then ctr1 = ctr1 + 1 End If SecondDir = Dir() Loop ctr = ctr + 1 Else End If FirstDir = Dir() ' Getting next entry. Loop MsgBox (ctr1) End Sub 

方法2通过recursion我在教程中find了这个基本的代码，然后在某种程度上对我进行了编辑。 这一般不起作用，但以某种硬编码的方式给出正确的答案。 但是我希望你能检查一下我被困在recursion函数中的位置，我需要添加文件处理代码。

 Public temp() As String Public Count As Integer Function ListFiles(FolderPath As String) Dim myFile As String, text As String, textline As String, posLat As Integer, posLong As Integer Dim k As Long, i As Long ReDim temp(2, 0) Count = 1 If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\" End If Recursive FolderPath k = Range(Application.Caller.Address).Rows.Count If k < UBound(temp, 2) Then MsgBox "There are more rows, extend user defined function" Else For i = UBound(temp, 2) To k ReDim Preserve temp(UBound(temp, 1), i) temp(0, i) = "" temp(1, i) = "" temp(2, i) = "" Next i End If ListFiles = Application.Transpose(temp) ReDim temp(0) End Function Function Recursive(FolderPath As String) Dim strFilename As String Dim strFileContent As String Dim iFile As Integer Dim fileName As String, textData As String, textRow As String, fileNo As Integer Dim Value As String, Folders() As String Dim Folder As Variant, a As Long Dim Right_FolderPath As String ReDim Folders(0) If Right(FolderPath, 2) = "\\" Then Exit Function Value = Dir(FolderPath, &H10) Do Until Value = "" If Value = "." Or Value = ".." Then Else If GetAttr(FolderPath & Value) = 16 Then Folders(UBound(Folders)) = Value ReDim Preserve Folders(UBound(Folders) + 1) Else If Right(Value, 4) = ".edf" Then If Count = 4 Then Right_FolderPath = Right(FolderPath, 7) If Left(Right_FolderPath, 2) = "DR" Then strFilename = FolderPath & Value iFile = FreeFile Open strFilename For Input As #iFile strFileContent = Input(LOF(iFile), iFile) Close #iFile If InStr(1, strFileContent, "hihowareyou") <> 0 Then ActiveSheet.Cells(1, 1) = strFilename longLoc = InStr(1, strFileContent, "Longitude:") If longLoc <> 0 Then ActiveSheet.Cells(1, 2) = Mid(strFleContent, longLoc + Len("Longitude:"), 10) End If End If ''''Here it goes all wrong 'myFile = FolderPath & Value 'myFile = Application.GetOpenFilename() 'fileNo = FreeFile 'Get first free file number 'Open fileName For Input As #fileNo 'Do While Not EOF(fileNo) ' Line Input #fileNo, textRow ' textData = textData & textRow 'Loop 'Close #fileNo 'posLat = InStr(text, "ff-ai") 'If Not posLat = vbNullString Then ' temp(0, UBound(temp, 2)) = Value 'End If temp(0, UBound(temp, 2)) = FolderPath temp(1, UBound(temp, 2)) = Value temp(2, UBound(temp, 2)) = Count ' FileLen(FolderPath & Value) ReDim Preserve temp(UBound(temp, 1), UBound(temp, 2) + 1) End If End If End If End If End If Value = Dir Loop For Each Folder In Folders Count = Count + 1 Recursive FolderPath & Folder & "\" Count = Count - 1 Next Folder End Function 

字典对象的第三种方法这是由股票溢出的人build议，为他工作，但不适合我。 我不知道vba足以debugging它。

 Sub build_FolderLevels(dFMs As Scripting.Dictionary, _ Optional sFM As String = "", _ Optional iFLDR As Long = 0) Dim d As Long, fp As String, vFMs As Variant If CBool(dFMs.Count) Then vFMs = dFMs.Keys For d = LBound(vFMs) To UBound(vFMs) vFMs(d) = vFMs(d) Next d Else vFMs = Array(sFM) End If dFMs.RemoveAll For d = LBound(vFMs) To UBound(vFMs) fp = Dir(vFMs(d), iFLDR) Do While CBool(Len(fp)) dFMs.Add Key:=Left(vFMs(d), InStrRev(vFMs(d), Chr(92))) & fp, _ Item:=iFLDR fp = Dir Loop Next d 

结束小组

 Sub main() Dim fm As Long, sFM As String, vFMs As Variant, sMASK As String Dim fn As Variant, dFNs As New Scripting.Dictionary sFM = Environ("TMP") & "\QSHWRA\FCS*\FUNCTION_BLOCK\DR*\*.edf" If UBound(Split(sFM, Chr(42))) < 2 Then Exit Sub '<~~possibly adjust this safety sFM = Replace(sFM, "/", "\") vFMs = Split(sFM, Chr(92)) sMASK = vFMs(LBound(vFMs)) For fm = LBound(vFMs) + 1 To UBound(vFMs) sMASK = Join(Array(sMASK, vFMs(fm)), Chr(92)) If CBool(InStr(1, vFMs(fm), Chr(42))) Or fm = UBound(vFMs) Then build_FolderLevels dFNs, sFM:=sMASK, iFLDR:=Abs((fm < UBound(vFMs)) * vbDirectory) sMASK = vbNullString End If Next fm 'list the files For Each fn In dFNs Debug.Print "from dict: " & fn Next fn dFNs.RemoveAll: Set dFNs = Nothing End Sub 

Answer 1

我build议你浏览主目录下的所有子文件夹，然后收集符合条件的文件。 我可能会使用类似于Dir MainFolder\*.edf /B /S （裸设置和recursion开关集）的WindowsShell，只保存或收集那些在所需子文件夹中的文件。 但是，你也可以做一些类似的DIR或FileSystemObject和recursion。