Logo 
Search:

MS Office Answers

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds
  Question Asked By: Adella Garcia   on Nov 22 In MS Office Category.

  
Question Answered By: Rose Hughes   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

Share: 

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