A Way to Query,(x).Xls files in (x)subfolders

Hi

You could do something like

Sub bbb()
  Set fs = Application.FileSearch
  With fs
    .LookIn = "c:\temp"
    .SearchSubFolders = True
    .Filename = "BOM*.xls"
    If .Execute() > 0 Then
      For i = 1 To .FoundFiles.Count
        outrow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        Cells(outrow, 1).Value = .FoundFiles(i)
      Next i
    End If
  End With
End Sub

If you want to include this in your extraction, then the

.foundfiles(i)

will give you the full path, and you can include that into your

cn.open

string. Then you will have to udpate your output cell to be something like

cells(rows.count,1).end(xlup).offset(1,0)

have fun....


rylo

Hello bdb1974,

The following macro will open a folder and then open each sub-folder. Each sub-folder will examined for files with names like "BOM*.xls", where the asterisk is a wildcard character. This will not examine sub-folders of sub-folders.

The macro is incomplete as you did not give more details about what you were searching for in column "A". Provide me with the details and I will add that to the macro for you.

Also, I have a few other questions. If the BOM worksheet names vary from file to file, will the worksheet always be in the same position: first sheet, second, etc. or will it be the same as the workbook name, like "BOM1"? If the worksheet name doesn't change then what are you using?

Sub GetBOMdata()
  
  Dim BOMfile As Object
  Dim BOMfiles As Object
  Dim BOMfolder As Object
  Dim BOMfolders As Object
  Dim BOMwkb As Workbook
  Dim BOMwks As Worksheet
  Dim DstWks As Worksheet
  Dim FSO As Object
  Dim LastRow As Long
  Dim MainFolder As String
  Dim Rng As Range
  Dim StartRow As Long
  
    StartRow = 2
    MainFolder = "C:\Documents and Settings\Admin.ADMINS\My Documents\"
    Set DstWks = ThisWorkbook.Worksheets("Sheet1")
    
      Set FSO = CreateObject("Scripting.FileSystemObject")
      Set BOMfolders = FSO.GetFolder(MainFolder).SubFolders
      
        For Each BOMfolder In BOMfolders
          Set BOMfiles = BOMfolder.Files
            For Each BOMfile In BOMfiles
              If BOMfile.Name Like "BOM*.xls" Then
                Set BOMwkb = Workbooks.Open(BOMfile.Path, ReadOnly:=True)
                Set BOMwks = BOMwkb.Worksheets("Sheet1")
                  ' Code to extract data from column "A"
                   With BOMwks
                     LastRow = .Cells(.Rows.Count, "A").Row
                     LastRow = IIf(LastRow < StartRow, StartRow, LastRow)
                     Set Rng = .Range(.Cells(StartRow, "A"), .Cells(LastRow, "A"))
                      ' Look for values in Rng
                   End With
                BOMwkb.Close SaveChanges:=False
              End If
            Next BOMfile
        Next BOMfolder
        
    Set FSO = Nothing
        
End Sub

Sincerely,
Leith Ross

Ultimately this is what I'd like to have happen.
I will be searching for values: between 360060 & 366447 in Column A, in a BOM*.xls
If found. I would would like
From the following file paths:
L:\Elec Dept Projects\Preliminary\*\BOM*.xls
L:\Elec Dept Projects\Pending\*\BOM*.xls
L:\Elec Dept Projects\Hold\*\BOM*.xls
L:\Elec Dept Projects\Released For Construction\*\BOM*.xls
L:\Elec Dept Projects\Complete\*\BOM*.xls
have the subfolder names: Preliminary,Pending,Hold,Released For Construction, or Complete to be listed in column L. and * (being a wildcard subfolder) be COLOR="Blue"]hyperlink listed[/COLOR] in column N. and the first 3 characters of *(being a wildcard subfolder), be listed in column M. in my workbook "TransformerAllocations" Worksheet"Sheet2" Starting with Row 9 & down,have if the Value found in BOM*.xls matches value in Column A of Worksheet"Sheet2. then be listed in the next available row (where cells in columns L,M,N of that row has no value or data in them). ot the row where th corresponding value in column A is listed. Or it can be set up to list the seached value in the next blank cell in column A.
I know this is a lot to ask, but, it would be great if some conditions could be added to the search and list macro. If the BOM*.xls is in directory Complete, then remove contents from columns A, L,M,N,O if subfolder is already listed in Sheet2 if found where the value on the same Row has value of Preliminary,Pending,Hold,Released,or Issued in Column L.

If the BOM*.xls is in directory,Released For Construction, then remove contents from columns A, L,M,N,O if subfolder is already listed in Sheet2 if found where the value on the same Row has value of Preliminary,Pending,Hold,in Column L.

If the BOM*.xls is in directory,Hold,then remove contents from columns A, L,M,N,O if subfolder is already listed in Sheet2 if found where the value on the same Row has value of Preliminary,Pending,in Column L.

If the BOM*.xls is in directory,Pending,then remove contents from columns A, L,M,N,O if subfolder is already listed in Sheet2 if found where the value on the same Row has value of Preliminary,in Column L.

Again, I know this is alot to ask for, but this would be a significant help. And hopefully
seeing a working code will help me improve my VBA macro skills which are currently at
a newbie level. Thanks again for all your help.

I have tried to use add /merge parts of this macro which adds hyperlinks
to Rylo's provided code. But have not had success, I keep getting syntax
errors,then reworked and getting invalid procedure or call argument.
I'd rather you guys work on my ultimate code wish.
But if not, then a fix to the code below would also be appreciated.
I've also attached a working example of a hyplink listing workbook.
I don't know if the code can be incorporated into making what I ultimately
looking for or not,but hoping it may help you in your efforts to help me.

Thanks again for the help.

Function Excludes(Ext As String) As Boolean
'Function purpose:  To exclude listed file extensions from hyperlink listing

Dim x, NumPos As Long

'Enter/adjust file extensions to EXCLUDE from listing here:
x = Array("exe", "bat", "dll", "zip")

On Error Resume Next
    NumPos = Application.WorksheetFunction.Match(Ext, x, 0)
    If NumPos > 0 Then Excludes = True
On Error GoTo 0

End Function

Sub bbb()
'Macro purpose:  To create a hyperlinked list of all files in a user
'specified directory, including file size and date last modified
'NOTE:  The 'TextToDisplay' property (of the Hyperlink object) was added
'in Excel 2000.  This code tests the Excel version and does not use the
'Texttodisplay property if using XL 97.

Dim fso As Object, _
    ShellApp As Object, _
    File As Object, _
    SubFolder As Object, _
    Directory As String, _
    Problem As Boolean, _
    ExcelVer As Integer
    
 

'Turn off screen flashing
Application.ScreenUpdating = False

'Create objects to get a listing of all files in the directory
Set fso = CreateObject("Scripting.FileSystemObject")

 Set fs = Application.FileSearch
  With fs
    .LookIn = "c:\temp\Syberia-Razor1911"
    
       .SearchSubFolders = True
    .Filename = "*.*"
    If .Execute() > 0 Then
      For i = 1 To .FoundFiles.Count
        outrow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        Cells(outrow, 1).Value = .FoundFiles(i)
      Next i
    End If
  End With
  

'Set up the headers on the worksheet
With ActiveSheet
    With .Range("A2")
        .Value = "Listing of all files in:"
        .ColumnWidth = 40
        'If Excel 2000 or greater, add hyperlink with file name
        'displayed.  If earlier, add hyperlink with full path displayed
        If Val(Application.Version) > 8 Then 'Using XL2000+
            .Parent.Hyperlinks.Add _
                Anchor:=.Offset(0, 1), _
                Address:=Directory, _
                TextToDisplay:=Directory
        Else 'Using XL97
            .Parent.Hyperlinks.Add _
                Anchor:=.Offset(0, 1), _
                Address:=Directory
        End If
    End With
    With .Range("A3")
        .Value = "File Name"
        .Interior.ColorIndex = 15
        With .Offset(0, 1)
            .ColumnWidth = 15
            .Value = "Date Modified"
            .Interior.ColorIndex = 15
            .HorizontalAlignment = xlCenter
        End With
        With .Offset(0, 2)
            .ColumnWidth = 15
            .Value = "File Size (Kb)"
            .Interior.ColorIndex = 15
            .HorizontalAlignment = xlCenter
        End With
    End With
End With

'Adds each file, details and hyperlinks to the list
For Each File In SubFolder
    If Not Excludes(Right(File.Path, 3)) = True Then
        With ActiveSheet
            'If Excel 2000 or greater, add hyperlink with file name
            'displayed.  If earlier, add hyperlink with full path displayed
            If Val(Application.Version) > 8 Then 'Using XL2000+
            .Hyperlinks.Add _
                Anchor:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0), _
                Address:=File.Path, _
                TextToDisplay:=File.Name
            Else 'Using XL97
            .Hyperlinks.Add _
                Anchor:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0), _
                Address:=File.Path
            End If
            'Add date last modified, and size in KB
            With .Range("A65536").End(xlUp)
                .Offset(0, 1) = File.datelastModified
                With .Offset(0, 2)
                    .Value = WorksheetFunction.Round(File.Size / 1024, 1)
                    .NumberFormat = "#,##0.0"
                End With
            End With
        End With
    End If
Next

End Sub

Hi

Ok, starting small.

1) I created directories (a) C:\Elec Dept Projects\Preliminary\suba and C:\Elec Dept Projects\Preliminary\subb
2) Created file C:\Elec Dept Projects\Preliminary\subb\BOMa.xls
3) In your workbook hyperlinks to projects folder.xls, added the code

Sub aaa()

'clean out any existing output data
Range("L:N").ClearContents
  Set fs = Application.FileSearch
  With fs
    .LookIn = "c:\elec dept projects"
    .SearchSubFolders = True
    .Filename = "bom*.xls"
    If .Execute() > 0 Then
      For i = 1 To .FoundFiles.Count
        outrow = WorksheetFunction.Max(2, Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row)
        Cells(outrow, "L").Resize(1, 3).Value = .FoundFiles(i)
      Next i
    End If
  End With
  'get rid of the known path items
  Range("L:M").Replace what:="c:\Elec Dept Projects\", replacement:=""
  
  'isolate out the first subfolder and remove from column N
  For i = 2 To Cells(Rows.Count, "L").End(xlUp).Row
    Cells(i, "L").Value = Left(Cells(i, "L").Value, InStr(1, Cells(i, "L").Value, "\") - 1)
    Cells(i, "M").Replace what:=Cells(i, "L").Value & "\", replacement:=""
    Cells(i, "M").Value = Left(Cells(i, "M").Value, 3)
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, "N"), Address:= _
        Cells(i, "N").Value, TextToDisplay:= _
        Cells(i, "N").Value
  Next i
  

End Sub

4) Selected sheet1 of that file and ran the code.

Is this output in columns L:N what you want? If not, then describe how it should be changed.

5) In [hyperlinks]sheet2!A8:A11 I have the values
ID
aaa
bbb
ccc

6) In [boma.xls]sheet1!A1:A4 I have the values
ID
ccc

Using those items, how / where / what do you want to display on sheet2 of hyperlinks. I got a bit lost on your description. How about, if the first part is OK, then you show the output you would expect to see. If I haven't got the file details / structures right to meet your situation, can you update your files and attach.


rylo

Rylo,

Thanks for starting on your assisting my needs.
I inserted the code you created and tried running it.
I'm getting a 400 error code when running the macro.
Also, It appears to be automatically deleting all the contents.
It should only delete the contents of the cells only if the subfolders have
been manually moved to the next stage of completions.
stage of completion/status changes is as follows:
preliminary>pending<or>hold>invoiced>released for construction>complete

And this,
deletion should happen to a row where the status is a past status and
should not delete the most current status list of the subfolder.
only when I run the macro to update.
The subfolders will be manually moved to each parent folder when the previous status has been completed.



I've attached a Rar files w/the folders and some example job folders with BOM's inside. The code should check the BOM for Column A. and then list
as previous describes in my last post.
Theres a folder called: Materials.
This hold the spreadsheet called:TRANSFORMER ALLOCATIONS.xls
This is where the code will be executed, from sheet2.
I've also placed another file in the Materials folder called: Book4.xls
It shows the different values in columnA the code should check for in the BOM.xl's.
I hope all this makes sense.
Again,
thanks for all your help.

Rylo,

here's an updated file of book4.xls showing a couple rows
of how the hyperlinks should be.

thanks,
BDB