Print All Subfolders Workbooks

[u473]

How do I adapt the following code from Bob Philips (to traverse all of
the folders and subfolders)
to print All Workbooks
Thank you for your help,
Wayne

' ***********************************************************
Sub CallingProc()
Dim strPath As String
Dim fso As Object
Dim oDir As Object


strPath = "P:\Accounts Receivable\Cost Centers"
Set fso = CreateObject("Scripting.FileSystemObject")
Set oDir = fso.getfolder(strPath)
PrintFolderName oDir


Set fso = Nothing
Set oDir = Nothing
End Sub


' ***********************************************************
Sub PrintFolderName(Dir As Object)
Dim fSubDir As Object


' Supposed to be recursive...
' Print the folder name.
Debug.Print Dir.Name
' Check subfolders recursively.
For Each fSubDir In Dir.SubFolders
PrintFolderName fSubDir
Next fSubDir
End Sub

 

[Chip Pearson]

Try the following code. You'll need to set a reference (in VBA, Tools menu,
References) to the Microsoft Scripting Runtime library. You might also be
interested in my Directory Tree Lister add-in at
http://www.cpearson.com/Excel/FolderTree.aspx . A procedure that calls
itself, as does the "ListSubFolders" procedure below, is called "recursive"
programming. See www.cpearson.com/Excel/RecursiveProgramming.aspx and
www.cpearson.com/Excel/RecursionAndFSO.htm .

Sub StartHere()
Dim StartFolder As Scripting.Folder
Dim FSO As Scripting.FileSystemObject
Dim R As Range

Set FSO = New Scripting.FileSystemObject
Set StartFolder = FSO.GetFolder("C:\ExcelProjects") '<<<< CHANGE FOLDER
Set R = Range("A1")

ListSubFolders FSO:=FSO, WhatFolder:=StartFolder, Rng:=R
End Sub


Sub ListSubFolders(FSO As Scripting.FileSystemObject, _
WhatFolder As Scripting.Folder, Rng As Range)
Dim SubFolder As Scripting.Folder
Rng.Value = WhatFolder.Path ' or .Name
Set Rng = Rng(2, 1)
For Each SubFolder In WhatFolder.SubFolders
ListSubFolders FSO, SubFolder, Rng
Next SubFolder
End Sub


--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)

 

[Chip Pearson]

I misread your post. To list workbook files, use the following code for the
ListSubFolders procedure.

Sub ListSubFolders(FSO As Scripting.FileSystemObject, _
WhatFolder As Scripting.Folder, Rng As Range)
Dim SubFolder As Scripting.Folder
Dim OneFile As Scripting.File
Dim S As String
Dim N As Long
For Each OneFile In WhatFolder.Files
N = InStrRev(OneFile.Name, ".")
If N > 0 Then
S = Mid(OneFile.Name, N)
Select Case S
Case ".xla", ".xls", ".xlsm", ".xlsx"
Rng.Value = OneFile.Path ' or .Name
Set Rng = Rng(2, 1)
Case Else
End Select
End If
Next OneFile
For Each SubFolder In WhatFolder.SubFolders
ListSubFolders FSO, SubFolder, Rng
Next SubFolder
End Sub



--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)

 

[u473]

Sorry, the error is mine, even if your code is already valuable to
me,
I am not after a list of workbook files.
I want to print every Subfolder, Workbook, Worksheet in the Base
Folder.
So, somewhere in your code I have to insert the statement
Workbook.Printout

Thank you again,
Wayne