Message Box Fires Multiple Times

Message box is firing several times when I run this on a batch of files. 3 files processed recently and the box fired 8 times. Didn't use to, and nothing changed in the macro so I don't know what to do.

Option Explicit

Dim FolderPath As String
Sub Prep()

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select a folder"
    .Show
    .AllowMultiSelect = False
    If .SelectedItems.Count = 0 Then    'Exit if none selected
        MsgBox "You did not select a folder”"
        Exit Sub
    End If
    FolderPath = .SelectedItems(1) & "\"
End With

SubfolderLoop FolderPath, True 'True includes subfolders; False excludes subfolders
   
End Sub

Sub SubfolderLoop(SourceFolderName As String, IncludeSubfolders As Boolean)

' set a reference to Microsoft Scripting Runtime

Dim fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim wbk As Workbook
Dim ws As Worksheet

Application.ScreenUpdating = False

Set fso = New Scripting.FileSystemObject
Set SourceFolder = fso.GetFolder(SourceFolderName)

For Each FileItem In SourceFolder.Files
    'Opens the file and assigns to the wbk variable for future use
    Set wbk = Workbooks.Open(SourceFolderName & FileItem.Name)

'Worksheets(3).Activate

    ActiveWorkbook.Unprotect Password:="purple"

    ActiveWorkbook.Worksheets("Sheet One").Visible = True
    ActiveWorkbook.Worksheets("Sheet Two").Visible = True
    ActiveWorkbook.Worksheets("Sheet Three").Visible = True
    ActiveWorkbook.Worksheets("Sheet Four").Visible = True
    ActiveWorkbook.Worksheets("Sheet Five").Visible = True
    ActiveWorkbook.Worksheets("Sheet Six").Visible = True
    ActiveWorkbook.Worksheets("Sheet Seven").Visible = True
    ActiveWorkbook.Worksheets("Sheet Eight").Visible = True
    ActiveWorkbook.Worksheets(9).Activate
    Range("A2").Select
    ActiveWorkbook.Worksheets("Sheet Ten").Visible = True
    ActiveWorkbook.Worksheets(3).Activate
    ActiveWorkbook.Worksheets(3).Unprotect Password:="purple"
    ActiveWindow.Zoom = 85
    Range("A15").Select
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollColumn = 1

wbk.Close True

Next FileItem

If IncludeSubfolders Then
    For Each SubFolder In SourceFolder.SubFolders
        SubfolderLoop SubFolder.Path & "\", True
    Next SubFolder
End If

Set FileItem = Nothing
Set SourceFolder = Nothing
Set fso = Nothing
Application.ScreenUpdating = True

MsgBox "Files are prepped", vbInformation, "Task Completed"

End Sub