In earlier versions Aplication.FileSearch could be used to loop through all the files contained in a Directory. This does not appear to work in 2007 versions. I have managed to use Dir to achieve this instead
--------------------------------------------------------------------------------------' Module : Module1
' DateTime : 09/05/2007 08:43
' Author : Roy Cox (royUK)' Website : www.excel-it.com for more examples and Excel Consulting
' Purpose : Open all worksheets in a specific folder' Disclaimer; This code is offered as is with no guarantees. You may use it in your' projects but please leave this header intact.
'---------------------------------------------------------------------------------------
Option Explicit
Sub Open_All_Files()
Dim oWbk As Workbook
Dim sFil As String
Dim sPath As String
sPath = "C:\Documents and Settings\Roy Cox\My Documents\" 'location of files
ChDir sPath
sFil = Dir("*.xlsx") 'change or add formats
Do While sFil <> "" 'will start LOOP until all files in folder sPath have been looped through Set oWbk = Workbooks.Open(sPath & "\" & sFil) 'opens the file
' do something
oWbk.Close True 'close the workbook, saving changes
sFil = Dir
Loop ' End of LOOP
End Sub
6 comments:
It was a relief to find your code, I have tried many ways of filesearch with negative result. Your code did the trick, both in 2003 and 2007, and will help me a lot with a task I have.
If you're looking for something which mimics some of the more complicated features in Application.FileSearch, Codematic have a replacement at
http://www.codematic.net/excel-tools/office-2007-filesearch.htm. You have to pay for it, but it's just a module you can copy-paste into your code.
This is just too easy. Simple and elegant, it does eaxctly what I wanted without having to resort to using the filesystemobject method outlined in many books.
Thanks
'!!!! Replacement solution including searching in subdirectories !!!
//------------------------------------------------------------------------------------------------
Sub FileSearchByHavrda_Example_of_procedure_calling()
'
' Example of FileSearchByHavrda procedure calling as replacement of missing FileSearch function in the newest MS Office VBA
' 01.06.2009, Author: P. Havrda, Czech Republic
'
Dim FileNameWithPath As Variant
Dim ListOfFilenamesWithParh As New Collection ' create a collection of filenames
' Filling a collection of filenames (search Excel files including subdirectories)
Call FileSearchByHavrda(ListOfFilenamesWithParh, "C:\Temp", "*.xls", True)
' Print list to immediate debug window and as a message window
For Each FileNameWithPath In ListOfFilenamesWithParh ' cycle for list(collection) processing
Debug.Print FileNameWithPath & Chr(13)
MsgBox FileNameWithPath & Chr(13)
Next FileNameWithPath
' Print to immediate debug window and message if no file was found
If ListOfFilenamesWithParh.Count = 0 Then
Debug.Print "No file was found !"
MsgBox "No file was found !"
End If
End Sub
//------------------------------------------------------------------------------------------------
Private Sub FileSearchByHavrda(pFoundFiles As Collection, pPath As String, pMask As String, pIncludeSubdirectories As Boolean)
'
' Search files in Path and create FoundFiles list(collection) of file names(path included) accordant with Mask (search in subdirectories if enabled)
' 01.06.2009, Author: P. Havrda, Czech Republic
'
Dim DirFile As String
Dim CollectionItem As Variant
Dim SubDirCollection As New Collection
' Add backslash at the end of path if not present
pPath = Trim(pPath)
If Right(pPath, 1) <> "\" Then pPath = pPath & "\"
' Searching files accordant with mask
DirFile = Dir(pPath & pMask)
Do While DirFile <> ""
pFoundFiles.Add pPath & DirFile 'add file name to list(collection)
DirFile = Dir ' next file
Loop
' Procedure exiting if searching in subdirectories isn't enabled
If Not pIncludeSubdirectories Then Exit Sub
' Searching for subdirectories in path
DirFile = Dir(pPath & "*", vbDirectory)
Do While DirFile <> ""
' Add subdirectory to local list(collection) of subdirectories in path
If DirFile <> "." And DirFile <> ".." Then If ((GetAttr(pPath & DirFile) And vbDirectory) = 16) Then SubDirCollection.Add pPath & DirFile
DirFile = Dir 'next file
Loop
' Subdirectories list(collection) processing
For Each CollectionItem In SubDirCollection
Call FileSearchByHavrda(pFoundFiles, CStr(CollectionItem), pMask, pIncludeSubdirectories) ' Recursive procedure call
Next
End Sub
//------------------------------------------------------------------------------------------------
I'm having a little trouble with this code. Even though the macro recognizes the sPath directory, it is looking in my documents when returning file names. Any help would be greatly appreciated.
Sub Open_All_Files()
Dim oWbk As Workbook
Dim sFil As String
Dim sPath As String
sPath = "\\Nt-mes-21\managebus2\Finance\Common\Excel-lence\Current Projects\SkylineChart\Data\" 'location of files
ChDir sPath
sFil = Dir("*.xls") 'change or add formats
Do While sFil <> "" 'will start LOOP until all files in folder sPath have been looped through
Set oWbk = Workbooks.Open(sPath & "\" & sFil) 'opens the file
' do something
oWbk.Close True 'close the workbook, saving changes
sFil = Dir
Loop ' End of LOOP
End Sub
Post a Comment