Open many workbooks in Excel & print one page

D

Darla

I have 80 workbooks that I need to open and print the summary tab for each
one and then close. Does anyone know how I could do this all at one time?
Is there some kind of macro that would work for this? I am a novice with
macros but would be willing to try but not sure how to begin.

Thank you for your help.
 
R

Ron de Bruin

Hi Darla

Try this for all files in the folder C:\Data
It will print the first sheet of each file.

Copy the code in a normal module in a workbook that is
not in the folder C:\Data.

Open a new workbook
Alt -F11
Insert>Module from the menu bar
paste the sub in there
Alt-Q to go back to Excel


If you do Alt-F8 you get a list of your macro's
Select "TestFile1" and press Run


Sub TestFile1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String


SaveDriveDir = CurDir
MyPath = "C:\Data"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
mybook.Sheets(1).PrintOut
mybook.Close False
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub
 
D

Darla

Thanks for responding so quickly, Ron!

I tried what you suggested and received an "invalid procedure call or
argument" error message. Could it be because the files I am accessing are on
a network drive?

Here is part of the macro. The "ChDrive MyPath" was highlighted in yellow
and it was referencing that as the problem..

SaveDriveDir = CurDir
MyPath = "\\mercy-5\cashlogs\WI Clinics\Evansville"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then

Because these files are all on the Network in the cashlogs folder but
located in different folders within that folder am I still going to be able
to do this?

Thanks again for your help!
 
R

Ron de Bruin

Hi Darla

Try this one, chnage RootPath = "C:\Data"


Sub FSO_Example_1()
Dim SubFolders As Boolean
Dim Fso_Obj As Object, RootFolder As Object
Dim SubFolderInRoot As Object, file As Object
Dim RootPath As String, FileExt As String
Dim MyFiles() As String, Fnum As Long
Dim mybook As Workbook

'Loop through all files in the Root folder
RootPath = "C:\Data"
'Loop through the subfolders True or False
SubFolders = True
'Loop through files with this extension
FileExt = ".xls"

'Add a slash at the end if the user forget it
If Right(RootPath, 1) <> "\" Then
RootPath = RootPath & "\"
End If

Set Fso_Obj = CreateObject("Scripting.FileSystemObject")
If Not Fso_Obj.FolderExists(RootPath) Then
MsgBox RootPath & " Not exist"
Exit Sub
End If

Set RootFolder = Fso_Obj.GetFolder(RootPath)

'Fill the array(myFiles)with the list of Excel files in the folder(s)
Fnum = 0
'Loop through the files in the RootFolder
For Each file In RootFolder.Files
If LCase(Right(file.Name, 4)) = FileExt Then
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = RootPath & file.Name
End If
Next file

'Loop through the files in the Sub Folders if SubFolders = True
If SubFolders Then
For Each SubFolderInRoot In RootFolder.SubFolders
For Each file In SubFolderInRoot.Files
If LCase(Right(file.Name, 4)) = FileExt Then
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = SubFolderInRoot & "\" & file.Name
End If
Next file
Next SubFolderInRoot
End If

' Now we can open the files in the array MyFiles to do what we want
'******************************************************************

On Error GoTo CleanUp
Application.ScreenUpdating = False

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyFiles(Fnum))
mybook.Sheets(1).PrintOut preview:=True
mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub
 
D

Darla

Hi Ron - This worked! Thank you for helping me solve my problem and for
responding to my question so quickly! You are a life saver!!
 
Top