We value your feedback.
Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!
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
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
|78 files, need to delete row 2 in every file||3||33|
|Excel - merge column values||3||26|
|VBA - How to copy the data from workbook to workbook masterfile in VBA?||19||41|
|Excel Index/Match issue||4||14|
Join the community of 500,000 technology professionals and ask your questions.