Excel Forum

Code: Select all

Public Sub NonRecursiveMethod()
    Dim fso, oFolder, oSubfolder, oFile, queue As Collection

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set queue = New Collection
    queue.Add fso.GetFolder("D:\Detail\wetransfer_2022-1-zip_2022-10-25_1306\")
    Do While queue.Count > 0
        Set oFolder = queue(1)
        queue.Remove 1 'dequeue
            For Each oSubfolder In oFolder.SubFolders
                queue.Add oSubfolder 'enqueue
            Next oSubfolder
        For Each oFile In oFolder.Files
          oFile = Dir("*FINAL COST*")
                Do While Len(oFile) > 0
                Debug.Print
                Loop
        Next oFile
    Loop
End Sub

Code: Select all

Sub sample2()
    Dim FileSystem As Object
    Dim HostFolder As String

    HostFolder = "D:\Detail\wetransfer_2022-1-zip_2022-10-25_1306\"

    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    DoFolder2 FileSystem.GetFolder(HostFolder)
End Sub

Sub DoFolder2(Folder)
    Dim SubFolder
    For Each SubFolder In Folder.SubFolders
        If found Then Exit For
        DoFolder2 SubFolder
    Next
    Dim File
    Dim n As Long
    For Each File In Folder.Files
        If found Then Exit For
            'for each InFile in Folder.File
                If Left(File.Name, 10) = "FINAL COST" Then
                    found = True
                        n = Range("A" & Rows.Count).End(xlUp).Row
                        Sheets("Sheet1").Range("B" & n + 1) = Folder.Name
                        Sheets("Sheet1").Range("A" & n + 1) = File.Name
                End If
            'Next
    Next
End Sub

Code: Select all

'Other code
Sub DoFolder2(Folder)
    Dim SubFolder, File
    Dim n As Long
    
    For Each SubFolder In Folder.SubFolders
        DoFolder2 SubFolder
    Next

    For Each File In Folder.Files
        If Left(File.Name, 10) = "FINAL COST" Then
            n = Range("A" & Rows.Count).End(xlUp).Row
            Sheets("Sheet1").Range("B" & n + 1) = Folder.Name
            Sheets("Sheet1").Range("A" & n + 1) = File.Name
        End If
    Next
End Sub

Code: Select all

Sub sample2()
    Dim FileSystem As Object
    Dim HostFolder As String

    HostFolder = "D:\Detail\wetransfer_2022-1-zip_2022-10-25_1306\"

    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    DoFolder2 FileSystem.GetFolder(HostFolder)
End Sub

Sub DoFolder2(Folder)
    Dim SubFolder
    For Each SubFolder In Folder.SubFolders
        DoFolder2 SubFolder
    Next
    Dim File
    Dim n As Long
    Dim n2 As Long
    Dim sh As Worksheet
    Dim tws As Workbook
    For Each File In Folder.Files
                If Left(File.Name, 10) = "FINAL COST" Then
                    found = True
                            n = Sheets("List").Range("A" & Rows.Count).End(xlUp).Row
                            n2 = Sheets("Detail1").Range("C" & Rows.Count).End(xlUp).Row
                            Sheets("List").Range("B" & n + 1) = Folder.Name
                            Sheets("List").Range("A" & n + 1) = File.Name
                            'myfile = Dir(File)
'                            ws = File.Workbook
                                For Each sh In tws
                                    If Left(sh.Name, 10) = "FINAL COST" Then
                                    Sheets("Detail1").Range("C" & n2 + 1) = Range("A12:AW12").Value
                                    End If
                                Next
'                                    With Workbooks(File)
'                                        If Left(sh.Name, 10) = "FINAL COST" Then
'                                        Sheets("Detail1").Range("C" & n2 + 1) = Range("A12:AW12").Value
'                                         End If
'                                    End With
                End If
    Next
End Sub

Code: Select all

Sub sample2()
    Dim FileSystem As Object
    Dim HostFolder As String

    HostFolder = "D:\Detail\wetransfer_2022-1-zip_2022-10-25_1306\"
    
    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    DoFolder2 FileSystem.GetFolder(HostFolder)
End Sub

Sub DoFolder2(Folder)
    Dim SubFolder
    Dim File
    Dim n As Long
    Dim n2 As Long
    Dim sh As Worksheet
    Dim tws As Workbook
    For Each SubFolder In Folder.SubFolders
        DoFolder2 SubFolder
    Next
    For Each File In Folder.Files
        If Left(File.Name, 10) = "FINAL COST" Then
            n = Sheets("List").Range("A" & Rows.Count).End(xlUp).Row
            n2 = Sheets("Detail1").Range("C" & Rows.Count).End(xlUp).Row
            Sheets("List").Range("B" & n + 1) = Folder.Name
            Sheets("List").Range("A" & n + 1) = File.Name
            Call GetSheetname(theFullName:=File)
        End If
    Next
End Sub

Sub ImportFile(sFile As String, sh As String)
    Dim sCnstr As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim sql As String, shtName As String
    On Error Resume Next
    shtName = "[" & VBA.Replace(sh, "'", "") & "]"
    sql = "select * from " & shtName
    sCnstr.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
        & "Data Source=" & sFile & ";" _
        & "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
    rs.Open sql, sCnstr
    With Worksheets("Sheet1")
        .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) _
            .CopyFromRecordset rs
    End With
    Set sCnstr = Nothing
    Set rs = Nothing
End Sub

Function GetSheetname(ByVal theFullName As String) As String
    Dim cn As ADODB.Connection
    Dim rsT As ADODB.Recordset
    Dim intTblCnt As Integer
    Dim strTbl As String
    Dim t As Integer
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
        & "Data Source=" & theFullName & ";" _
        & "Extended Properties=""Excel 12.0 Xml;HDR=NO"";"

    Set rsT = cn.OpenSchema(adSchemaTables)
    intTblCnt = rsT.RecordCount

    Do While Not rsT.EOF
        strTbl = rsT.Fields("TABLE_NAME").Value
        If Right(strTbl, 2) = "$'" And VBA.Left(strTbl, 11) = "'COST SHEET" Then
           Call ImportFile(sFile:=theFullName, sh:=strTbl)
        End If
        rsT.MoveNext
    Loop
    rsT.Close
    cn.Close
End Function