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.
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
Insertgt;Module from the menu bar
paste the sub in there
Alt-Q to go back to ExcelIf you do Alt-F8 you get a list of your macro's
Select quot;TestFile1quot; and press RunSub TestFile1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As StringSaveDriveDir = CurDir
MyPath = quot;C:\Dataquot;
ChDrive MyPath
ChDir MyPath
FNames = Dir(quot;*.xlsquot;)
If Len(FNames) = 0 Then
MsgBox quot;No files in the Directoryquot;
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If
Application.ScreenUpdating = False
Do While FNames lt;gt; quot;quot;
Set mybook = Workbooks.Open(FNames)
mybook.Sheets(1).PrintOut
mybook.Close False
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub
--
Regards Ron de Bruin
www.rondebruin.nlquot;Darlaquot; gt; wrote in message news
gt;I have 80 workbooks that I need to open and print the summary tab for each
gt; one and then close. Does anyone know how I could do this all at one time?
gt; Is there some kind of macro that would work for this? I am a novice with
gt; macros but would be willing to try but not sure how to begin.
gt;
gt; Thank you for your help.
Thanks for responding so quickly, Ron!
I tried what you suggested and received an quot;invalid procedure call or
argumentquot; error message. Could it be because the files I am accessing are on
a network drive?
Here is part of the macro. The quot;ChDrive MyPathquot; was highlighted in yellow
and it was referencing that as the problem..
SaveDriveDir = CurDir
MyPath = quot;\\mercy-5\cashlogs\WI Clinics\Evansvillequot;
ChDrive MyPath
ChDir MyPath
FNames = Dir(quot;*.xlsquot;)
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!quot;Ron de Bruinquot; wrote:
gt; Hi Darla
gt;
gt; Try this for all files in the folder C:\Data
gt; It will print the first sheet of each file.
gt;
gt; Copy the code in a normal module in a workbook that is
gt; not in the folder C:\Data.
gt;
gt; Open a new workbook
gt; Alt -F11
gt; Insertgt;Module from the menu bar
gt; paste the sub in there
gt; Alt-Q to go back to Excel
gt;
gt;
gt; If you do Alt-F8 you get a list of your macro's
gt; Select quot;TestFile1quot; and press Run
gt;
gt;
gt; Sub TestFile1()
gt; Dim basebook As Workbook
gt; Dim mybook As Workbook
gt; Dim FNames As String
gt; Dim MyPath As String
gt; Dim SaveDriveDir As String
gt;
gt;
gt; SaveDriveDir = CurDir
gt; MyPath = quot;C:\Dataquot;
gt; ChDrive MyPath
gt; ChDir MyPath
gt; FNames = Dir(quot;*.xlsquot;)
gt; If Len(FNames) = 0 Then
gt; MsgBox quot;No files in the Directoryquot;
gt; ChDrive SaveDriveDir
gt; ChDir SaveDriveDir
gt; Exit Sub
gt; End If
gt;
gt; Application.ScreenUpdating = False
gt; Do While FNames lt;gt; quot;quot;
gt; Set mybook = Workbooks.Open(FNames)
gt; mybook.Sheets(1).PrintOut
gt; mybook.Close False
gt; FNames = Dir()
gt; Loop
gt; ChDrive SaveDriveDir
gt; ChDir SaveDriveDir
gt; Application.ScreenUpdating = True
gt; End Sub
gt;
gt; --
gt; Regards Ron de Bruin
gt; www.rondebruin.nl
gt;
gt;
gt; quot;Darlaquot; gt; wrote in message news
gt; gt;I have 80 workbooks that I need to open and print the summary tab for each
gt; gt; one and then close. Does anyone know how I could do this all at one time?
gt; gt; Is there some kind of macro that would work for this? I am a novice with
gt; gt; macros but would be willing to try but not sure how to begin.
gt; gt;
gt; gt; Thank you for your help.
gt;
gt;
gt;
Hi Darla
Try this one, chnage RootPath = quot;C:\Dataquot;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 = quot;C:\Dataquot;
'Loop through the subfolders True or False
SubFolders = True
'Loop through files with this extension
FileExt = quot;.xlsquot;
'Add a slash at the end if the user forget it
If Right(RootPath, 1) lt;gt; quot;\quot; Then
RootPath = RootPath amp; quot;\quot;
End If
Set Fso_Obj = CreateObject(quot;Scripting.FileSystemObjectquot;)
If Not Fso_Obj.FolderExists(RootPath) Then
MsgBox RootPath amp; quot; Not existquot;
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 amp; 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 amp; quot;\quot; amp; 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 gt; 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
--
Regards Ron de Bruin
www.rondebruin.nlquot;Darlaquot; gt; wrote in message ...
gt; Thanks for responding so quickly, Ron!
gt;
gt; I tried what you suggested and received an quot;invalid procedure call or
gt; argumentquot; error message. Could it be because the files I am accessing are on
gt; a network drive?
gt;
gt; Here is part of the macro. The quot;ChDrive MyPathquot; was highlighted in yellow
gt; and it was referencing that as the problem..
gt;
gt; SaveDriveDir = CurDir
gt; MyPath = quot;\\mercy-5\cashlogs\WI Clinics\Evansvillequot;
gt; ChDrive MyPath
gt; ChDir MyPath
gt; FNames = Dir(quot;*.xlsquot;)
gt; If Len(FNames) = 0 Then
gt;
gt; Because these files are all on the Network in the cashlogs folder but
gt; located in different folders within that folder am I still going to be able
gt; to do this?
gt;
gt; Thanks again for your help!
gt;
gt;
gt; quot;Ron de Bruinquot; wrote:
gt;
gt;gt; Hi Darla
gt;gt;
gt;gt; Try this for all files in the folder C:\Data
gt;gt; It will print the first sheet of each file.
gt;gt;
gt;gt; Copy the code in a normal module in a workbook that is
gt;gt; not in the folder C:\Data.
gt;gt;
gt;gt; Open a new workbook
gt;gt; Alt -F11
gt;gt; Insertgt;Module from the menu bar
gt;gt; paste the sub in there
gt;gt; Alt-Q to go back to Excel
gt;gt;
gt;gt;
gt;gt; If you do Alt-F8 you get a list of your macro's
gt;gt; Select quot;TestFile1quot; and press Run
gt;gt;
gt;gt;
gt;gt; Sub TestFile1()
gt;gt; Dim basebook As Workbook
gt;gt; Dim mybook As Workbook
gt;gt; Dim FNames As String
gt;gt; Dim MyPath As String
gt;gt; Dim SaveDriveDir As String
gt;gt;
gt;gt;
gt;gt; SaveDriveDir = CurDir
gt;gt; MyPath = quot;C:\Dataquot;
gt;gt; ChDrive MyPath
gt;gt; ChDir MyPath
gt;gt; FNames = Dir(quot;*.xlsquot;)
gt;gt; If Len(FNames) = 0 Then
gt;gt; MsgBox quot;No files in the Directoryquot;
gt;gt; ChDrive SaveDriveDir
gt;gt; ChDir SaveDriveDir
gt;gt; Exit Sub
gt;gt; End If
gt;gt;
gt;gt; Application.ScreenUpdating = False
gt;gt; Do While FNames lt;gt; quot;quot;
gt;gt; Set mybook = Workbooks.Open(FNames)
gt;gt; mybook.Sheets(1).PrintOut
gt;gt; mybook.Close False
gt;gt; FNames = Dir()
gt;gt; Loop
gt;gt; ChDrive SaveDriveDir
gt;gt; ChDir SaveDriveDir
gt;gt; Application.ScreenUpdating = True
gt;gt; End Sub
gt;gt;
gt;gt; --
gt;gt; Regards Ron de Bruin
gt;gt; www.rondebruin.nl
gt;gt;
gt;gt;
gt;gt; quot;Darlaquot; gt; wrote in message news
gt;gt; gt;I have 80 workbooks that I need to open and print the summary tab for each
gt;gt; gt; one and then close. Does anyone know how I could do this all at one time?
gt;gt; gt; Is there some kind of macro that would work for this? I am a novice with
gt;gt; gt; macros but would be willing to try but not sure how to begin.
gt;gt; gt;
gt;gt; gt; Thank you for your help.
gt;gt;
gt;gt;
gt;gt;
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!!
quot;Ron de Bruinquot; wrote:
gt; Hi Darla
gt;
gt; Try this one, chnage RootPath = quot;C:\Dataquot;
gt;
gt;
gt; Sub FSO_Example_1()
gt; Dim SubFolders As Boolean
gt; Dim Fso_Obj As Object, RootFolder As Object
gt; Dim SubFolderInRoot As Object, file As Object
gt; Dim RootPath As String, FileExt As String
gt; Dim MyFiles() As String, Fnum As Long
gt; Dim mybook As Workbook
gt;
gt; 'Loop through all files in the Root folder
gt; RootPath = quot;C:\Dataquot;
gt; 'Loop through the subfolders True or False
gt; SubFolders = True
gt; 'Loop through files with this extension
gt; FileExt = quot;.xlsquot;
gt;
gt; 'Add a slash at the end if the user forget it
gt; If Right(RootPath, 1) lt;gt; quot;\quot; Then
gt; RootPath = RootPath amp; quot;\quot;
gt; End If
gt;
gt; Set Fso_Obj = CreateObject(quot;Scripting.FileSystemObjectquot;)
gt; If Not Fso_Obj.FolderExists(RootPath) Then
gt; MsgBox RootPath amp; quot; Not existquot;
gt; Exit Sub
gt; End If
gt;
gt; Set RootFolder = Fso_Obj.GetFolder(RootPath)
gt;
gt; 'Fill the array(myFiles)with the list of Excel files in the folder(s)
gt; Fnum = 0
gt; 'Loop through the files in the RootFolder
gt; For Each file In RootFolder.Files
gt; If LCase(Right(file.Name, 4)) = FileExt Then
gt; Fnum = Fnum 1
gt; ReDim Preserve MyFiles(1 To Fnum)
gt; MyFiles(Fnum) = RootPath amp; file.Name
gt; End If
gt; Next file
gt;
gt; 'Loop through the files in the Sub Folders if SubFolders = True
gt; If SubFolders Then
gt; For Each SubFolderInRoot In RootFolder.SubFolders
gt; For Each file In SubFolderInRoot.Files
gt; If LCase(Right(file.Name, 4)) = FileExt Then
gt; Fnum = Fnum 1
gt; ReDim Preserve MyFiles(1 To Fnum)
gt; MyFiles(Fnum) = SubFolderInRoot amp; quot;\quot; amp; file.Name
gt; End If
gt; Next file
gt; Next SubFolderInRoot
gt; End If
gt;
gt; ' Now we can open the files in the array MyFiles to do what we want
gt; '************************************************* *****************
gt;
gt; On Error GoTo CleanUp
gt; Application.ScreenUpdating = False
gt;
gt; 'Loop through all files in the array(myFiles)
gt; If Fnum gt; 0 Then
gt; For Fnum = LBound(MyFiles) To UBound(MyFiles)
gt; Set mybook = Workbooks.Open(MyFiles(Fnum))
gt; mybook.Sheets(1).PrintOut preview:=True
gt; mybook.Close savechanges:=False
gt; Next Fnum
gt; End If
gt; CleanUp:
gt; Application.ScreenUpdating = True
gt; End Sub
gt;
gt;
gt;
gt; --
gt; Regards Ron de Bruin
gt; www.rondebruin.nl
gt;
gt;
gt; quot;Darlaquot; gt; wrote in message ...
gt; gt; Thanks for responding so quickly, Ron!
gt; gt;
gt; gt; I tried what you suggested and received an quot;invalid procedure call or
gt; gt; argumentquot; error message. Could it be because the files I am accessing are on
gt; gt; a network drive?
gt; gt;
gt; gt; Here is part of the macro. The quot;ChDrive MyPathquot; was highlighted in yellow
gt; gt; and it was referencing that as the problem..
gt; gt;
gt; gt; SaveDriveDir = CurDir
gt; gt; MyPath = quot;\\mercy-5\cashlogs\WI Clinics\Evansvillequot;
gt; gt; ChDrive MyPath
gt; gt; ChDir MyPath
gt; gt; FNames = Dir(quot;*.xlsquot;)
gt; gt; If Len(FNames) = 0 Then
gt; gt;
gt; gt; Because these files are all on the Network in the cashlogs folder but
gt; gt; located in different folders within that folder am I still going to be able
gt; gt; to do this?
gt; gt;
gt; gt; Thanks again for your help!
gt; gt;
gt; gt;
gt; gt; quot;Ron de Bruinquot; wrote:
gt; gt;
gt; gt;gt; Hi Darla
gt; gt;gt;
gt; gt;gt; Try this for all files in the folder C:\Data
gt; gt;gt; It will print the first sheet of each file.
gt; gt;gt;
gt; gt;gt; Copy the code in a normal module in a workbook that is
gt; gt;gt; not in the folder C:\Data.
gt; gt;gt;
gt; gt;gt; Open a new workbook
gt; gt;gt; Alt -F11
gt; gt;gt; Insertgt;Module from the menu bar
gt; gt;gt; paste the sub in there
gt; gt;gt; Alt-Q to go back to Excel
gt; gt;gt;
gt; gt;gt;
gt; gt;gt; If you do Alt-F8 you get a list of your macro's
gt; gt;gt; Select quot;TestFile1quot; and press Run
gt; gt;gt;
gt; gt;gt;
gt; gt;gt; Sub TestFile1()
gt; gt;gt; Dim basebook As Workbook
gt; gt;gt; Dim mybook As Workbook
gt; gt;gt; Dim FNames As String
gt; gt;gt; Dim MyPath As String
gt; gt;gt; Dim SaveDriveDir As String
gt; gt;gt;
gt; gt;gt;
gt; gt;gt; SaveDriveDir = CurDir
gt; gt;gt; MyPath = quot;C:\Dataquot;
gt; gt;gt; ChDrive MyPath
gt; gt;gt; ChDir MyPath
gt; gt;gt; FNames = Dir(quot;*.xlsquot;)
gt; gt;gt; If Len(FNames) = 0 Then
gt; gt;gt; MsgBox quot;No files in the Directoryquot;
gt; gt;gt; ChDrive SaveDriveDir
gt; gt;gt; ChDir SaveDriveDir
gt; gt;gt; Exit Sub
gt; gt;gt; End If
gt; gt;gt;
gt; gt;gt; Application.ScreenUpdating = False
gt; gt;gt; Do While FNames lt;gt; quot;quot;
gt; gt;gt; Set mybook = Workbooks.Open(FNames)
gt; gt;gt; mybook.Sheets(1).PrintOut
gt; gt;gt; mybook.Close False
gt; gt;gt; FNames = Dir()
gt; gt;gt; Loop
gt; gt;gt; ChDrive SaveDriveDir
gt; gt;gt; ChDir SaveDriveDir
gt; gt;gt; Application.ScreenUpdating = True
gt; gt;gt; End Sub
gt; gt;gt;
gt; gt;gt; --
gt; gt;gt; Regards Ron de Bruin
gt; gt;gt; www.rondebruin.nl
gt; gt;gt;
gt; gt;gt;
gt; gt;gt; quot;Darlaquot; gt; wrote in message news
gt; gt;gt; gt;I have 80 workbooks that I need to open and print the summary tab for each
gt; gt;gt; gt; one and then close. Does anyone know how I could do this all at one time?
gt; gt;gt; gt; Is there some kind of macro that would work for this? I am a novice with
gt; gt;gt; gt; macros but would be willing to try but not sure how to begin.
gt; gt;gt; gt;
gt; gt;gt; gt; Thank you for your help.
gt; gt;gt;
gt; gt;gt;
gt; gt;gt;
gt;
gt;
gt;
You are welcome
Thanks for the feedback
--
Regards Ron de Bruin
www.rondebruin.nlquot;Darlaquot; gt; wrote in message ...
gt; Hi Ron - This worked! Thank you for helping me solve my problem and for
gt; responding to my question so quickly! You are a life saver!!
gt;
gt;
gt;
gt; quot;Ron de Bruinquot; wrote:
gt;
gt;gt; Hi Darla
gt;gt;
gt;gt; Try this one, chnage RootPath = quot;C:\Dataquot;
gt;gt;
gt;gt;
gt;gt; Sub FSO_Example_1()
gt;gt; Dim SubFolders As Boolean
gt;gt; Dim Fso_Obj As Object, RootFolder As Object
gt;gt; Dim SubFolderInRoot As Object, file As Object
gt;gt; Dim RootPath As String, FileExt As String
gt;gt; Dim MyFiles() As String, Fnum As Long
gt;gt; Dim mybook As Workbook
gt;gt;
gt;gt; 'Loop through all files in the Root folder
gt;gt; RootPath = quot;C:\Dataquot;
gt;gt; 'Loop through the subfolders True or False
gt;gt; SubFolders = True
gt;gt; 'Loop through files with this extension
gt;gt; FileExt = quot;.xlsquot;
gt;gt;
gt;gt; 'Add a slash at the end if the user forget it
gt;gt; If Right(RootPath, 1) lt;gt; quot;\quot; Then
gt;gt; RootPath = RootPath amp; quot;\quot;
gt;gt; End If
gt;gt;
gt;gt; Set Fso_Obj = CreateObject(quot;Scripting.FileSystemObjectquot;)
gt;gt; If Not Fso_Obj.FolderExists(RootPath) Then
gt;gt; MsgBox RootPath amp; quot; Not existquot;
gt;gt; Exit Sub
gt;gt; End If
gt;gt;
gt;gt; Set RootFolder = Fso_Obj.GetFolder(RootPath)
gt;gt;
gt;gt; 'Fill the array(myFiles)with the list of Excel files in the folder(s)
gt;gt; Fnum = 0
gt;gt; 'Loop through the files in the RootFolder
gt;gt; For Each file In RootFolder.Files
gt;gt; If LCase(Right(file.Name, 4)) = FileExt Then
gt;gt; Fnum = Fnum 1
gt;gt; ReDim Preserve MyFiles(1 To Fnum)
gt;gt; MyFiles(Fnum) = RootPath amp; file.Name
gt;gt; End If
gt;gt; Next file
gt;gt;
gt;gt; 'Loop through the files in the Sub Folders if SubFolders = True
gt;gt; If SubFolders Then
gt;gt; For Each SubFolderInRoot In RootFolder.SubFolders
gt;gt; For Each file In SubFolderInRoot.Files
gt;gt; If LCase(Right(file.Name, 4)) = FileExt Then
gt;gt; Fnum = Fnum 1
gt;gt; ReDim Preserve MyFiles(1 To Fnum)
gt;gt; MyFiles(Fnum) = SubFolderInRoot amp; quot;\quot; amp; file.Name
gt;gt; End If
gt;gt; Next file
gt;gt; Next SubFolderInRoot
gt;gt; End If
gt;gt;
gt;gt; ' Now we can open the files in the array MyFiles to do what we want
gt;gt; '************************************************* *****************
gt;gt;
gt;gt; On Error GoTo CleanUp
gt;gt; Application.ScreenUpdating = False
gt;gt;
gt;gt; 'Loop through all files in the array(myFiles)
gt;gt; If Fnum gt; 0 Then
gt;gt; For Fnum = LBound(MyFiles) To UBound(MyFiles)
gt;gt; Set mybook = Workbooks.Open(MyFiles(Fnum))
gt;gt; mybook.Sheets(1).PrintOut preview:=True
gt;gt; mybook.Close savechanges:=False
gt;gt; Next Fnum
gt;gt; End If
gt;gt; CleanUp:
gt;gt; Application.ScreenUpdating = True
gt;gt; End Sub
gt;gt;
gt;gt;
gt;gt;
gt;gt; --
gt;gt; Regards Ron de Bruin
gt;gt; www.rondebruin.nl
gt;gt;
gt;gt;
gt;gt; quot;Darlaquot; gt; wrote in message ...
gt;gt; gt; Thanks for responding so quickly, Ron!
gt;gt; gt;
gt;gt; gt; I tried what you suggested and received an quot;invalid procedure call or
gt;gt; gt; argumentquot; error message. Could it be because the files I am accessing are on
gt;gt; gt; a network drive?
gt;gt; gt;
gt;gt; gt; Here is part of the macro. The quot;ChDrive MyPathquot; was highlighted in yellow
gt;gt; gt; and it was referencing that as the problem..
gt;gt; gt;
gt;gt; gt; SaveDriveDir = CurDir
gt;gt; gt; MyPath = quot;\\mercy-5\cashlogs\WI Clinics\Evansvillequot;
gt;gt; gt; ChDrive MyPath
gt;gt; gt; ChDir MyPath
gt;gt; gt; FNames = Dir(quot;*.xlsquot;)
gt;gt; gt; If Len(FNames) = 0 Then
gt;gt; gt;
gt;gt; gt; Because these files are all on the Network in the cashlogs folder but
gt;gt; gt; located in different folders within that folder am I still going to be able
gt;gt; gt; to do this?
gt;gt; gt;
gt;gt; gt; Thanks again for your help!
gt;gt; gt;
gt;gt; gt;
gt;gt; gt; quot;Ron de Bruinquot; wrote:
gt;gt; gt;
gt;gt; gt;gt; Hi Darla
gt;gt; gt;gt;
gt;gt; gt;gt; Try this for all files in the folder C:\Data
gt;gt; gt;gt; It will print the first sheet of each file.
gt;gt; gt;gt;
gt;gt; gt;gt; Copy the code in a normal module in a workbook that is
gt;gt; gt;gt; not in the folder C:\Data.
gt;gt; gt;gt;
gt;gt; gt;gt; Open a new workbook
gt;gt; gt;gt; Alt -F11
gt;gt; gt;gt; Insertgt;Module from the menu bar
gt;gt; gt;gt; paste the sub in there
gt;gt; gt;gt; Alt-Q to go back to Excel
gt;gt; gt;gt;
gt;gt; gt;gt;
gt;gt; gt;gt; If you do Alt-F8 you get a list of your macro's
gt;gt; gt;gt; Select quot;TestFile1quot; and press Run
gt;gt; gt;gt;
gt;gt; gt;gt;
gt;gt; gt;gt; Sub TestFile1()
gt;gt; gt;gt; Dim basebook As Workbook
gt;gt; gt;gt; Dim mybook As Workbook
gt;gt; gt;gt; Dim FNames As String
gt;gt; gt;gt; Dim MyPath As String
gt;gt; gt;gt; Dim SaveDriveDir As String
gt;gt; gt;gt;
gt;gt; gt;gt;
gt;gt; gt;gt; SaveDriveDir = CurDir
gt;gt; gt;gt; MyPath = quot;C:\Dataquot;
gt;gt; gt;gt; ChDrive MyPath
gt;gt; gt;gt; ChDir MyPath
gt;gt; gt;gt; FNames = Dir(quot;*.xlsquot;)
gt;gt; gt;gt; If Len(FNames) = 0 Then
gt;gt; gt;gt; MsgBox quot;No files in the Directoryquot;
gt;gt; gt;gt; ChDrive SaveDriveDir
gt;gt; gt;gt; ChDir SaveDriveDir
gt;gt; gt;gt; Exit Sub
gt;gt; gt;gt; End If
gt;gt; gt;gt;
gt;gt; gt;gt; Application.ScreenUpdating = False
gt;gt; gt;gt; Do While FNames lt;gt; quot;quot;
gt;gt; gt;gt; Set mybook = Workbooks.Open(FNames)
gt;gt; gt;gt; mybook.Sheets(1).PrintOut
gt;gt; gt;gt; mybook.Close False
gt;gt; gt;gt; FNames = Dir()
gt;gt; gt;gt; Loop
gt;gt; gt;gt; ChDrive SaveDriveDir
gt;gt; gt;gt; ChDir SaveDriveDir
gt;gt; gt;gt; Application.ScreenUpdating = True
gt;gt; gt;gt; End Sub
gt;gt; gt;gt;
gt;gt; gt;gt; --
gt;gt; gt;gt; Regards Ron de Bruin
gt;gt; gt;gt; www.rondebruin.nl
gt;gt; gt;gt;
gt;gt; gt;gt;
gt;gt; gt;gt; quot;Darlaquot; gt; wrote in message news
gt;gt; gt;gt; gt;I have 80 workbooks that I need to open and print the summary tab for each
gt;gt; gt;gt; gt; one and then close. Does anyone know how I could do this all at one time?
gt;gt; gt;gt; gt; Is there some kind of macro that would work for this? I am a novice with
gt;gt; gt;gt; gt; macros but would be willing to try but not sure how to begin.
gt;gt; gt;gt; gt;
gt;gt; gt;gt; gt; Thank you for your help.
gt;gt; gt;gt;
gt;gt; gt;gt;
gt;gt; gt;gt;
gt;gt;
gt;gt;
gt;gt;
- Nov 03 Mon 2008 20:47
Open many workbooks in Excel amp; print one page
close
全站熱搜
留言列表
發表留言
留言列表

