Excel

Open All Workbooks In a Folder

Ease of Use

Easy

Version tested with

2000, 2002 

Submitted by:

Justinlabenne

Description:

Opens all Excel workbooks in a specified folder from the opening of a master workbook 

Discussion:

If you have a project that contains multiple workbooks, you may want to open up one master file, and have the rest of the workbooks open at the same time. This code uses a Workbook Open event to open all the Excel files that are stored in a specified folder. All the workbooks inside the folder are assumed to be related to the project, so they are all opened. There may be issues if you are opening a large number of workbooks or the size of the workbooks you are opening are of very large sizes. This will result in an Out of Memory error and the code will stop abrubtly. There is a check for file size totals against the available resources to ensure that this code will catch this error, and run it's cleanup code. The total number of workbooks will not be opened if the resources are used up, but the error will be avoided. There is a function included to check for workbooks that are also already opened to avoid errors there also. 

Code:

instructions for use

			

Option Explicit Private Sub Workbook_Open() ' Folder Name: Const szFolderName As String = "\Project Books" Dim wkb As Workbook Dim szWkbNames As String Dim szOpenWkbNames As String Dim i As Long ' Obtain max resources available for Excel Dim lMaxSize As Long lMaxSize = Application.MemoryTotal ' Obtain the initial file size Dim lSize As Long lSize = FileLen(ThisWorkbook.FullName) ' This workbook's path Dim szThisPath As String szThisPath = ThisWorkbook.Path ' Build a path to include the project folder Dim szProjectPath As String szProjectPath = szThisPath & szFolderName ' Grab the name of our Master workbook ' Used to ensure this workbook becomes active after ' opening all the other files Dim szMasterBook As String szMasterBook = ThisWorkbook.Name ' Find all Excel workbooks in the folder With Application.FileSearch .NewSearch .SearchSubFolders = False .LookIn = szProjectPath .FileType = msoFileTypeExcelWorkbooks .Execute ' if we found some files to open: If .FoundFiles.Count > 0 Then ' Stop screen flicker of workbooks being opened Application.ScreenUpdating = False ' ============================================================= ' Simple loop, opening the workbooks For i = 1 To .FoundFiles.Count If IsWbOpen(.FoundFiles(i)) Then szOpenWkbNames = szOpenWkbNames & _ vbNewLine & StripFromPath(.FoundFiles(i)) Goto NextFile End If Set wkb = Workbooks.Open(.FoundFiles(i)) ' Store workbooks name in a variable for later use szWkbNames = szWkbNames & vbNewLine & wkb.Name ' Check that we have not used up all available resources: lSize = lSize + FileLen(ActiveWorkbook.FullName) ' If we have, exit the loop because we cannot open up anymore files If lSize >= lMaxSize Then Goto MaxedOut NextFile: Next i ' ============================================================= ErrExit: ' Enable Screen Update Property Application.ScreenUpdating = True ' Make our Master Wokrbook active Workbooks(szMasterBook).Activate ' For this example, just deliver a message ' stating which books were opened, or which books were ' already opened + the workbooks opened If szOpenWkbNames <> CStr(Empty) Then MsgBox "These workbooks were already open:" & _ vbNewLine & szOpenWkbNames & _ vbNewLine & vbNewLine & _ "These workbooks were opened:" & vbNewLine & szWkbNames Else MsgBox "These workbooks were opened:" & vbNewLine & szWkbNames End If Else MsgBox "No workbooks were found in folder *" & _ Replace(szFolderName, "\", CStr(Empty)) & "*", 64 End If End With ' Explicitly clear memory Set wkb = Nothing Exit Sub MaxedOut: MsgBox "The maximum amount of workbooks have been opened", 64 Goto ErrExit End Sub Private Function IsWbOpen(wbName As String) As Boolean ' Check if a workbook is open Dim i As Long For i = Workbooks.Count To 1 Step -1 If Workbooks(i).FullName = wbName Then Exit For Next If i <> 0 Then IsWbOpen = True End Function Private Function StripFromPath(FullPath As String) As String ' Cut the file name out of a full path Dim szStrip As String Dim szFile As String Dim i As Long If Len(FullPath) > 0 Then szStrip = CStr(Empty) i = Len(FullPath) Do While szStrip <> "\" szStrip = Mid$(FullPath, i, 1) If szStrip = "\" Then szFile = Right$(FullPath, Len(FullPath) - i) End If i = i - 1 Loop StripFromPath = szFile End If End Function

How to use:

  1. Open an Excel Workbook
  2. Copy the code
  3. Right Click on the Excel Icon in the top left corner > View Code
  4. Paste code into the right pane
  5. Press Alt+Q to return to Excel
  6. Save workbook before any other changes
 

Test the code:

  1. Use the example to see how it is set up, to use this code in your own projects, the folder name and location may be different.
  2. The example assumes that the folder containing the workbooks to open is named "Project Books" and that is is located in the same location as the workbook with the code.
 

Sample File:

Open All Books.zip 25.89KB 

Approved by mdmackillop


This entry has been viewed 294 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2014 VBA Express