Code to search subfolders

[hlngus]

Got the following to work only on subfolder, but it want to make it
work for main folder and subfolders. This routine checks for files
updated within last 90 days that contain the word "translate" in them.

Sub DoIt()
Dim i As Integer
Dim sLoc As String
Dim vFiles As Variant
Dim vFolders As Variant
Dim Filename As String
Dim outfile As String


' The following folder with 00 subfolders works, when there are no
subfolders below
sLoc = "c:\mainfolder\00\"

vFiles = FillFileNames(sLoc)
vFolders = FillFolders(sLoc)
Dim n As Integer
n = 0

' Gets type mismatch here when search from main folder, and sLoc = "c:
\mainfolder\"
For i = LBound(vFiles) To UBound(vFiles)
'Debug.Print vFiles(i)

Dim L As Long, S As String, FileNum As Integer
FileNum = FreeFile
Filename = vFiles(i)
Open Filename For Binary Access Read Shared As
#FileNum
L = LOF(FileNum)
S = Space$(L)
Get #1, , S
Close #FileNum


If InStr(1, S, "translate") And DateDiff("d", Now,
FileDateTime(vFiles(i))) > -90 Then

n = n + 1

Debug.Print vFiles(i) & " old eps file " & n & " " &
Format(FileDateTime(vFiles(i)), "yyyymmdd") & " " & DateDiff("d", Now,
FileDateTime(vFiles(i)))


End If
Next i

' This works with the following 3 lines commented out, , when there
are no subfolders below.
'For i = LBound(vFolders) To UBound(vFolders)
' Debug.Print vFolders(i)
'Next i

Debug.Print "end"
End Sub


Function FillFolders(sLoc As String) As Variant
Dim sFolder As String
Dim sFolders() As String
sFolder = Dir(sLoc, vbDirectory)
Do While sFolder <> ""
If sFolder <> "." And sFolder <> ".." Then
If (GetAttr(sLoc & sFolder) And vbDirectory) = vbDirectory Then
ReDim Preserve sFolders(i)
sFolders(i) = sFolder
i = i + 1
End If
End If
sFolder = Dir
Loop
FillFolders = sFolders()
End Function


Function FillFileNames(sLoc As String) As Variant
Dim i As Integer
Dim sFileNames() As String
If Dir(sLoc) <> "" Then
With Application.FileSearch
.LookIn = "c:\mainfolder\00\"
' problem when search from main folder, and LookIn= "c:
\mainfolder\"
.Filename = "."
.SearchSubFolders = True
.Execute
For i = 0 To .FoundFiles.Count - 1
ReDim Preserve sFileNames(i)
sFileNames(i) = .FoundFiles(i + 1)
Next i
End With
FillFileNames = sFileNames()
End If
End Function

Thanks for any reply.

 

[Doug Robbins - Word MVP]

See the following attributed to Tushar Metha:

Process all files in a folder and, optionally, in sub-folders
A frequent request one runs into is for some way in which one can apply some
change to all the files in a folder. This case presents a modularized
solution. While the implementation may look complex -- it does use a
recursive routine to process sub-folders -- the result is a "black box" that
should be used without any modification.
An example of how one would use the code is below. The ListAllFiles
subroutine is the main code routine. It calls the "black box" module named
searchForFiles with the appropriate arguments, one of which is a 'callback'
routine. In this example, the callback routine is named processOneFile.
Sub ListAllFiles()
searchForFiles "C:\tushar\temp\", "processOneFile", "*.*", True
End Sub
Sub processOneFile(ByVal aFilename As String)
Debug.Print aFilename
End Sub
Copy the code below into a standard module in your Visual Basic project. At
the bottom is the example from above. The solution uses one application
specific method, the Run method. Consequently, it can be used on any
platform that supports the Run method. These applications include -- but
may not be limited to -- Excel, Word, and PowerPoint.
Option Explicit
'A modularized solution to process all files in a folder, and optionally all
subfolders in the folder _
Tushar Mehta

'There should be absolutely no reason to modify the searchForFiles
subroutine. Treat it as a blackbox _
routine. Do *not* tweak it for each specific search.

'How to use the subroutine: _
Call it with the four arguments: _
DirToSearch: The directory you want to search. Note that it must *not*
end in a path separator _
( "\" on a Windows OS) _
ProcToCall: This is the callback procedure called with the full name of
each file found _
FileTypeToFind: This is a search pattern for the files sought. For
example, to find all Excel _
files use "*.xls". This argument is optional and defaults to "*.*"
(or all files) _
SearchSubDir: Boolean that specifies whether or not to search nested
folders. The default is False.

'The callback subroutine is where you process each file found. The
signature for the routine should be _
Sub {subroutine-name}(ByVal aFilename As String)
'Use this callback subroutine to do whatever it is you want to do with each
file found. For an example, _
see the processOneFile subroutine below.

Sub searchForFiles(ByVal DirToSearch As String, ByVal ProcToCall As String,
_
Optional ByVal FileTypeToFind As String = "*.*", _
Optional ByVal SearchSubDir As Boolean = False)
'by Tushar Mehta
'This subroutine recursively calls itself if SearchSubDir is true and at
least one sub-directory exists. _
There should be no need to make any changes to this routine for any
specific search.
On Error GoTo ErrXIT
If Right(DirToSearch, 1) = Application.PathSeparator Then _
DirToSearch = Left(DirToSearch, Len(DirToSearch) - 1)
If SearchSubDir Then
Dim aFolder As String, SubFolders() As String
ReDim SubFolders(0)
aFolder = Dir(DirToSearch, vbDirectory)
Do While aFolder <> ""
If aFolder <> "." And aFolder <> ".." Then
SubFolders(UBound(SubFolders)) = aFolder
ReDim Preserve SubFolders(UBound(SubFolders) + 1)
End If
aFolder = Dir()
Loop
If UBound(SubFolders) <> LBound(SubFolders) Then
Dim I As Long
For I = LBound(SubFolders) To UBound(SubFolders) - 1
searchForFiles _
DirToSearch & Application.PathSeparator & SubFolders(I),
_
ProcToCall, FileTypeToFind, SearchSubDir
Next I
End If
End If
Dim aFile As String
aFile = Dir(DirToSearch & Application.PathSeparator & FileTypeToFind)
Do While aFile <> ""
aFile = DirToSearch & Application.PathSeparator & aFile
If (GetAttr(aFile) And vbDirectory) = vbDirectory Then
searchForFiles aFile, ProcToCall, FileTypeToFind, SearchSubDir
Else
Application.Run ProcToCall, aFile
End If
aFile = Dir()
Loop
Exit Sub
ErrXIT:
MsgBox "Fatal error: " & Err.Description & " (Code=" & Err.Number & ")"
Exit Sub
End Sub

'This is an example of how to use the above subroutine

Sub ListAllFiles()
searchForFiles "C:\tushar\temp\", "processOneFile", "*.*", True
End Sub
Sub processOneFile(ByVal aFilename As String)
Debug.Print aFilename
End Sub


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com