I've attached a workbook containing two macros PrintWorkbooks and
Traversethat together do what you are describing.  Invoke
PrintWorkBooks and provide the full starting path (e.g. C:\TEST).  Starting
at this point all subdirectories are traversed and each workbook found is
opened and sheets meeting your criterion are printed.  Note, that you need
to uncomment the  lines in Traverse that actually do the printing to insert
the appropriate criteria.  If you have any questions let me know.
Tom

On Mon, Nov 10, 2008 at 6:55 PM, Howy <[EMAIL PROTECTED]> wrote:

>
> Thanks, I've got that working nicely thanks. I just need it to drill
> through subdirectories now.
>
> On Nov 7, 3:10 pm, "Akhilesh Karna" <[EMAIL PROTECTED]> wrote:
> > Hi,
> >
> > Your purpose can be achieved by minor improvement in your code. You can
> > replace the following part of first macro.
> >
> >            With Workbooks(sCurFile)
> >
> > >                .Worksheets(2).PrintOut
> > >                .Worksheets(3).PrintOut
> > >                .Close SaveChanges:=False
> > >            End With
> >
> > replace with
> >
> > call PrintMost
> >
> > > activeworkbook.close SaveChanges:=False
> >
> > Hope this works. You need not combine the two functions, rather use both
> of
> > them.
> >
> > Akhilesh Kumar Karna
> >
> > On Fri, Nov 7, 2008 at 9:39 AM, Howy <[EMAIL PROTECTED]> wrote:
> >
> > > Hi there,
> >
> > > I have a timesheet spreadsheet i have designed, for each employee they
> > > have a workbook. in a directory and subdirectories by there pay
> > > location.
> >
> > > I would like to create a macro in a new workbook. Which asks the path
> > > the workbooks are in then prints the worksheets if data exists in a
> > > range on that workbook. I am not super experienced with vba however
> > > i've found the two following snippets of code which as i see need to
> > > be joined up.
> >
> > > Ideally i'd like to drill into subdirectories but that is not urgent.
> >
> > > This code prints sheets 2 & 3 of each workbook, however i want it to
> > > only print the sheets if a value exists in a range. I've pasted a code
> > > below which does something similar.
> >
> > > Public Sub PrintWorkbooks()
> > >    Dim sCurFile As String
> > >    Dim sPath As String
> >
> > >    'Get the path
> > >    sPath = InputBox("Starting path?", "PrintWorkbooks")
> > >    If sPath <> "" Then
> > >        On Error Resume Next
> > >        Application.ScreenUpdating = False
> > >        If Right(sPath, 1) <> "\" Then
> > >            sPath = sPath & "\"
> > >        End If
> > >        sCurFile = Dir(sPath & "*.xls", vbNormal)
> > >        Do While Len(sCurFile) <> 0
> > >            Workbooks.Open sPath & sCurFile, , True
> > >            With Workbooks(sCurFile)
> > >                .Worksheets(2).PrintOut
> > >                .Worksheets(3).PrintOut
> > >                .Close SaveChanges:=False
> > >            End With
> > >            sCurFile = Dir
> > >            DoEvents
> > >        Loop
> > >        Application.ScreenUpdating = True
> > >        On Error GoTo 0
> > >    End If
> > > End Sub
> >
> > > This code prints sheets if a value exists on each sheet.
> >
> > > Sub PrintMost()
> > >    Dim wks As Worksheet
> > >    For Each wks In ActiveWorkbook.Worksheets
> > >        If Not IsEmpty(wks.Range("G41")) Then
> > >            wks.PrintOut
> > >        End If
> > >    Next
> > >    Set wks = Nothing
> > > End Sub
> >
> > > Can anyone help me combine these two functions.
> >
> > > Any help is much appreciatted
> >
> > > Kind regards,
> >
> > > Ben Howard
>
> >
>

--~--~---------~--~----~------------~-------~--~----~
Visit the blog to download Excel tutorials at 
http://www.excel-macros.blogspot.com

To post to this group, send email to excel-macros@googlegroups.com
For more options, visit this group at 
http://groups.google.com/group/excel-macros?hl=en

Visit & Join Our Orkut Community at 
http://www.orkut.com/Community.aspx?cmm=22913620

Visit the blog to download Excel tutorials at 
http://www.excel-macros.blogspot.com

To Learn VBA Macros Please visit http://www.vbamacros.blogspot.com

To see the Daily Excel Tips, Go to:
http://exceldailytip.blogspot.com
-~----------~----~----~----~------~----~------~--~---

Attachment: traverse.xls
Description: MS-Excel spreadsheet

Reply via email to