对于在excel vba中的目录中进行选择性循环,哪种方法是最好的

对于在excel vba中的目录中进行选择性循环,哪种方法是最好的,excel,vba,Excel,Vba,IO希望检查路径主目录/ABC*/Y/XY*/*.edf中的所有edf文件,然后检查文件中的特定短语,如果找到,则检查其他短语,依此类推,然后在电子表格中填充数据。我试图通过三种方法来实现这一点,但在每种方法中都遇到了一些问题。你们中的任何人都可以通过代码告诉我哪里错了,哪种方法最好(如果有的话)。正如我之前的问题所造成的误解,我不希望任何人为我编写代码。我已经开始在vba上工作了三天,我有五天的时间来完成这个项目。这就是为什么如果有人能看一眼并告诉我哪里出了问题,我将不胜感激 通过简单目录命令

IO希望检查路径主目录/ABC*/Y/XY*/*.edf中的所有edf文件,然后检查文件中的特定短语,如果找到,则检查其他短语,依此类推,然后在电子表格中填充数据。我试图通过三种方法来实现这一点,但在每种方法中都遇到了一些问题。你们中的任何人都可以通过代码告诉我哪里错了,哪种方法最好(如果有的话)。正如我之前的问题所造成的误解,我不希望任何人为我编写代码。我已经开始在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 我在一个教程中找到了这方面的基本代码,然后对其进行了一些编辑,使其对我有利。这不是一般的工作方式,但以某种硬编码的方式给出了正确的答案。但是我想让你检查一下我在递归函数中遇到的问题,在这里我需要添加文件处理代码

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
端接头

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
Sub-main()
Dim fm为长,sFM为字符串,vFMs为变体,sMASK为字符串
Dim fn作为变体,dFNs作为新脚本。字典
sFM=Environ(“TMP”)和“\QSHWRA\FCS*\FUNCTION\u BLOCK\DR*\*.edf”

如果UBound(Split(sFM,Chr(42))<2,那么退出Sub',我建议您检查主目录下的所有子文件夹,只收集符合条件的文件。我可能会将WindowsShell与
Dir MainFolder\*.edf/B/S
(设置了裸格式和递归开关)一起使用,只需保存或收集所需子文件夹中的文件即可。但是您也可以对DIR或FileSystemObject和递归执行类似的操作。

您的DIR请求是否解析为
basefolder/X*/*.edf
或等效文件?在
CMD
窗口中,该语法类型无效。通配符似乎只允许出现在路径的最后一段。我不明白。我的路径是这样的,但我在代码中所做的。我给出的基本路由是主目录。例如,在您的第一个代码中,
SecondDir
的值可能是多少?FirstDir的值是
main directory/FSC*
一次一个。SecondDir是
{FirstDir&“/FUNCTION\u BLOCK/”
,通过运行循环,它应该迭代到以“DR”开头的所有目录但循环不起作用。主目录是代码中的
C:\Users\sobiakanwal\Downloads\QSHWRA\QSHWRA\
。因此,如果SecondDir=`Main Directory\FSC*\FUNCTION\u BLOCK`在最后一节之外有通配符,则无效。
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