|
|
|
|
|
|
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()
Const szFolderName As String = "\Project Books"
Dim wkb As Workbook
Dim szWkbNames As String
Dim szOpenWkbNames As String
Dim i As Long
Dim lMaxSize As Long
lMaxSize = Application.MemoryTotal
Dim lSize As Long
lSize = FileLen(ThisWorkbook.FullName)
Dim szThisPath As String
szThisPath = ThisWorkbook.Path
Dim szProjectPath As String
szProjectPath = szThisPath & szFolderName
Dim szMasterBook As String
szMasterBook = ThisWorkbook.Name
With Application.FileSearch
.NewSearch
.SearchSubFolders = False
.LookIn = szProjectPath
.FileType = msoFileTypeExcelWorkbooks
.Execute
If .FoundFiles.Count > 0 Then
Application.ScreenUpdating = False
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))
szWkbNames = szWkbNames & vbNewLine & wkb.Name
lSize = lSize + FileLen(ActiveWorkbook.FullName)
If lSize >= lMaxSize Then GoTo MaxedOut
NextFile:
Next i
ErrExit:
Application.ScreenUpdating = True
Workbooks(szMasterBook).Activate
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
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
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
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:
|
- Open an Excel Workbook
- Copy the code
- Right Click on the Excel Icon in the top left corner > View Code
- Paste code into the right pane
- Press Alt+Q to return to Excel
- Save workbook before any other changes
|
Test the code:
|
- 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.
- 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 304 times.
|
|