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