Look up the FileSearch object in VBA Help. To search a folder hierarchy, set
the SearchSubfolders property to True
Jonathan,
Thanks for your reply.
Whilst I am doing the above I came across the code beow which lists
all the files in sub-folders.
The
Debug.Print varItem
line below prints out each file name and its path in a series of
sub-folders.
I wonder if you could show me how I could use this info in varItem to
call a sub-routine which would act on each file?
Cheers
Geoff
Sub TestGetFiles()
' Call to test GetFiles function.
Dim dctDict As Scripting.Dictionary
Dim varItem As Variant
Dim strDirPath As String
strDirPath = "c:\a-temp1\"
' Create new dictionary.
Set dctDict = New Scripting.Dictionary
' Call recursively, return files into Dictionary object.
If GetFiles(strDirPath, dctDict, True) Then
' Print items in dictionary.
For Each varItem In dctDict
Debug.Print varItem
Next
End If
End Sub
Function GetFiles(strPath As String, _
dctDict As Scripting.Dictionary, _
Optional blnRecursive As Boolean) As Boolean
' This procedure returns all the files in a directory into
' a Dictionary object. If called recursively, it also returns
' all files in subfolders.
Dim fsoSysObj As Scripting.FileSystemObject
Dim fdrFolder As Scripting.Folder
Dim fdrSubFolder As Scripting.Folder
Dim filFile As Scripting.File
' Return new FileSystemObject.
Set fsoSysObj = New Scripting.FileSystemObject
On Error Resume Next
' Get folder.
Set fdrFolder = fsoSysObj.GetFolder(strPath)
If Err <> 0 Then
' Incorrect path.
GetFiles = False
GoTo GetFiles_End
End If
On Error GoTo 0
' Loop through Files collection, adding to dictionary.
For Each filFile In fdrFolder.Files
dctDict.Add filFile.Path, filFile.Path
Next filFile
' If Recursive flag is true, call recursively.
If blnRecursive Then
For Each fdrSubFolder In fdrFolder.SubFolders
GetFiles fdrSubFolder.Path, dctDict, True
Next fdrSubFolder
End If
' Return True if no error occurred.
GetFiles = True
GetFiles_End:
Exit Function
End Function
' Return True if no error occurred.
''GetFiles = True
''GetFiles_End:
''Exit Function
''End Function
Sub MyMacro(strMyFile As String)
' this gets called once for each file that meets the spec you enter in
ForEachPresentation
' strMyFile is set to the file name each time
' Probably at a minimum, you'd want to:
Dim oPresentation As Presentation
Set oPresentation = Presentations.Open(strMyFile)
With oPresentation
Dim oSh As shape
Dim bFoundButton As Boolean
Dim bFoundRectangle As Boolean
bFoundButton = False ' to start
With ActivePresentation.Slides(ActivePresentation.Slides.Count)
If .Shapes.Count > 0 Then
For Each oSh In _
ActivePresentation.Slides(ActivePresentation.Slides.Count) _
.Shapes
If oSh.Type = 1 Then
If oSh.AutoShapeType = 130 Then
bFoundButton = True
End If
End If
Next
' Now display a message
' If bFoundButton Then
' MsgBox "Found a Forward or Next button on the last slide"
'Else
' MsgBox "No Forward/Next buttons here"
'End If
If Not bFoundButton Then
MsgBox "No button on last slide of " & strMyFile
End If
Else
MsgBox "No shape on this last slide in " & strMyFile
End If
End With
oPresentation.Close
End With
Set oSh = Nothing
Set oPresentation = Nothing
End Sub
