MS Office Forum

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds

mutiple foldes/worksheet files/sheets extract

  Asked By: Adella    Date: Nov 22    Category: MS Office    Views: 1860

I have a folder name templates which has many sub-folders some has 3
some has 4 characters name, each sub folder has multiple XLS
worksheet files that are some times similar and some times different
in names from the other subfolders worksheet files. Each worksheet
file has multiple sheets that are some times similar and some times
different in names from the other worksheet files within the same
sub-folder and/or the others sub-folders.

Where I need the help is to have a code that will search for a
specific headings which could be single cell and/or a range of cells
in all and/or specified worksheet files in all and/or specified
subfolders and extract a data range underneath that headings row
based on a specified numbers of rows and columns and output the
result in a specified sheet name.



1 Answer Found

Answer #1    Answered By: Rose Hughes     Answered On: Nov 22

I'm surprised someone hasn't jumped on this one by now!
Here's something I threw together from some other things I've done.
Basically, it loops through folders and subfolders, looking for .xls
files, then Opens each file and loops through the sheets.

Option Explicit
Public fso
Sub Search_XLS()
Dim start_fldr As String, stat
Set fso = CreateObject("Scripting.FileSystemObject")
start_fldr = "C:\templates"
stat = GetFolderInfo(start_fldr)
End Sub
Function GetFolderInfo(FolderName As String)
Dim fldr, fldrs, FldrName, File, stat
Debug.Print "================ " & FolderName & " ================"
Set fldr = fso.getfolder(FolderName)
For Each File In fldr.Files
If (UCase(fso.getextensionname(File.Path)) = "XLS") Then
stat = GetFileData(File.Path)
End If
Next File
Set fldrs = fldr.subfolders
For Each FldrName In fldrs
stat = GetFolderInfo(FldrName.Path)
Next FldrName
End Function
Function GetFileData(XLSFile As String)
Dim BaseName, fil, SHT
Set fil = fso.getfile(XLSFile)
BaseName = fil.Name
Debug.Print XLSFile
Workbooks.Open Filename:=XLSFile, ReadOnly:=True
For Each SHT In Workbooks(BaseName).Sheets
Debug.Print BaseName & ": sht: " & SHT.Name
'Add your code  here
Next SHT
Workbooks(BaseName).Close savechanges:=False
End Function

Didn't find what you were looking for? Find more on mutiple foldes/worksheet files/sheets extract Or get search suggestion and latest updates.