This particular code was written for use in an email attachment that was essentially part of the UI for a larger application, but it can also be used for a main UI. Externally storing settings for a main UI makes it possible for mutliple users to use the same file or copies of the same file to ease development. Some developers prefer to store settings in the registry, but having had bad experiences with registries, I prefer to store settings in a workbook located in a hidden folder.



This goes in a Module (mine is called 'mWorkbook'):

Option Explicit
Option Base 1

Public Sub myWBBeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 If (Left(ActiveSheet.Name, 5) = "Sheet") Then ShowUI (True): Exit Sub 'blank form, opened by main ss
 Dim subN&:  subN = SubStart(Updating, Events, , , , PrimaryCall)
   
    'check if this is the blank form, opened by main ss
    If (Left(ActiveSheet.Name, 5) = "Sheet") Then GoTo ExitNow
   
    If ThisWorkbook.Sheets("UserNames").Range("PathAvailable") Then SaveComments

'    'this is for sending file as an attachment
'    With ThisWorkbook.Sheets("UserNames").Range("PathAvailable")
'        'test comments path again
'        If Not .Value Then TestCommentsPath
'        'save comments if path is available
'        If .Value Then Call SaveComments
'    End With
   
    'if saved to temporary directory
    With ThisWorkbook.Sheets("UserNames")
        If Not SaveAsUI Then
            If Not .[PromptUserSave_ReturnValue] Then
                If (Left(ThisWorkbook.Path, 7) = "C:\Temp") Then
                    'user canceled SaveAs, so don't prompt again
                    If Not fPromptUserSave Then .[PromptUserSave_ReturnValue] = True
                ElseIf (Left(ThisWorkbook.Path, Len(.[MainPath])) = .[MainPath]) Then
                    'user canceled SaveAs, so don't prompt again
                    If Not fPromptUserSave Then .[PromptUserSave_ReturnValue] = True
                End If
            End If
        End If
    End With
   
ExitNow:
 SubEnd (subN)
End Sub

Public Sub myWBOpen()
 If (Left(ActiveSheet.Name, 5) = "Sheet") Then ShowUI (True): Exit Sub 'blank form, opened by main ss
 Dim subN&:  subN = SubStart(Updating, Events, Warnings, , , (Left(ActiveSheet.Name, 5) <> "Sheet")) 'events should be supressed when this is opened by main wb, but testing sheet name just to be sure
   
    'hide comments column if path not accessible
    TestCommentsPath 'not necessary when file accessed directly via a link rather than as attachment
   
    Dim tempStr$:  tempStr = GetStoredPath
   
    If TestLen(tempStr) Then
        If (ThisWorkbook.Path <> tempStr) Then
            If (MsgBox("Save to your default directory (" & tempStr & ")?", vbYesNo, "") = vbYes) Then
                If FileFolderExists(tempStr) Then
                    ThisWorkbook.SaveAs tempStr & "\" & ThisWorkbook.Name
                Else
                    MsgBox ("Your default path (" & tempStr & ") is not available.")
                    DeleteHiddenFile
                    fPromptUserSave
                End If
            ElseIf (MsgBox("Reset your default directory (" & tempStr & ")" & Chr(10) & _
                    "(Answer 'No' if you wish to opt out of using a default directory)", vbYesNo, "") = vbYes) Then
                DeleteHiddenFile
            ElseIf (MsgBox("Do you wish to opt out of using a default directory?", vbYesNo, "") = vbYes) Then
                MsgBox ("If you wish to undo this action in the future, please let us know.")
                StoreUserPath ("")
            End If
        End If
    Else
        fPromptUserSave
    End If

    ShowUI (False)

ExitNow:
 SubEnd (subN)
End Sub

Private Function fPromptUserSave(Optional inPath$) As Boolean
 Dim subN&:  subN = SubStart(NoWarnings:=Warnings)
   
    Dim sPath$, StoredPath$, RetVal As Boolean
   
    Dim tempStr$, OriginalDir$:  OriginalDir = CurDir
    If TestLen(inPath) Then sPath = inPath Else StoredPath = GetStoredPath: sPath = StoredPath
    'use your own path here
    If Not TestLen(sPath) Then sPath = "C:\Desktop"
    tempStr = Left(sPath, 1)
    ChDrive tempStr
    sPath = sPath & "\" '& ThisWorkbook.Name
    ChDir sPath
   
    sPath = sPath & ThisWorkbook.Name
           
    On Error Resume Next
    If (ThisWorkbook.Path & "\" & ThisWorkbook.Name <> sPath) Then
        If FileFolderExists(sPath) Then SetAttr sPath, vbNormal:  Kill sPath
    End If
    ThisWorkbook.SaveAs sPath
    RetVal = Application.Dialogs(xlDialogSaveAs).Show(sPath)
    If (ThisWorkbook.Path & "\" & ThisWorkbook.Name <> sPath) Then
        If FileFolderExists(sPath) Then SetAttr sPath, vbNormal:  Kill sPath
    End If
    On Error GoTo 0

    If Not TestLen(StoredPath) And RetVal Then
        If (Left(sPath, Len(Sheets("UserNames").[MainPath])) <> Sheets("UserNames").[MainPath]) Then
            If (Len(CurDir) > 3) Then
                If (MsgBox("Do you want to store this path (" & CurDir & _
                            ") as your default directory for this report?", vbYesNo, "") = vbYes) Then
                    StoreUserPath (CurDir)
                ElseIf (MsgBox("Do you wish to opt out of using a default directory?", vbYesNo, "") = vbYes) Then
                    MsgBox ("If you wish to undo this action in the future, please let us know.")
                    StoreUserPath ("")
                End If
            End If
        End If
    End If
    fPromptUserSave = RetVal

    ChDir OriginalDir

 SubEnd (subN)
End Function

Private Function DeleteHiddenFile()

    Dim sPath$:  sPath = GetMyDocumentsPath & "\T+1 Report Data\HiddenFile.xls"
    If FileFolderExists(sPath) Then
        SetAttr sPath, vbNormal:  Kill sPath
    End If
   
End Function

Private Function GetStoredPath$()
'cells(1,1) = region
'cells(2,1) = path

    Dim sPath$:  sPath = GetMyDocumentsPath & "\T+1 Report Data\HiddenFile.xls"
   
    If FileFolderExists(sPath) Then
        Workbooks.Open sPath
        GetStoredPath = Cells(2, 1)
        ActiveWorkbook.Close
    Else
        GetStoredPath = ""
    End If

End Function

Private Sub StoreUserPath(SelectedPath$)
'cells(1,1) = region
'cells(2,1) = path

    Dim tempPath$:  tempPath = GetMyDocumentsPath & "\T+1 Report Data"
    If Not FileFolderExists(tempPath) Then MkDir tempPath
    tempPath = tempPath & "\HiddenFile.xls"

    If FileFolderExists(tempPath) Then
        Workbooks.Open Filename:=tempPath
        Cells(2, 1) = SelectedPath
    Else
        Workbooks.Add
        Cells(2, 1) = SelectedPath
        ActiveWorkbook.SaveAs tempPath
    End If
    ActiveWorkbook.Close

End Sub

Private Sub TestCommentsPath()

    On Error Resume Next
   
    With ThisWorkbook.Sheets("UserNames")
        If FileFolderExists(.Range("MainPath")) Then
            'path for comment CSV file is available
            .Range("PathAvailable") = True
        Else
            'path not accessible from user's account or location
            HideNewCommentsCol
            .Range("PathAvailable") = False
        End If
    End With
   
End Sub

Private Sub HideNewCommentsCol()
'this is called if comments path is not accessilbe, bc user won't be able to enter new comments

    Dim ws, tempVar, ActiveWS$:  ActiveWS = ActiveSheet.Name
    For Each ws In ThisWorkbook.Sheets
        If ws.Visible And (ws.Name <> "SUMMARY") Then
            With ws
                tempVar = cMatch("NEW COMMENT", .Name)
                If IsNumeric(tempVar) Then
                    .Columns(tempVar).Hidden = 1
                End If
            End With
        End If
    Next
    If (ActiveSheet.Name <> ActiveWS) Then Sheets(ActiveWS).Select

End Sub

Private Sub ShowUI(Show As Boolean)
'hide/show some of Excel's UI

    If (ActiveWorkbook.Name = ThisWorkbook.Name) Then
        With ActiveWindow
            If (CountVisibleSheets = 1) Then
'optional:
''                .DisplayWorkbookTabs = 0
            Else
                .DisplayWorkbookTabs = 1
            End If
            .DisplayHorizontalScrollBar = Show
            .DisplayVerticalScrollBar = Show
        End With
    End If
    With Application
'optional:
''        .DisplayFullScreen = Not Show
''        .DisplayFormulaBar = Show
'        .DisplayStatusBar = Show
        .ShowStartupDialog = Show
        .ShowWindowsInTaskbar = Show
        .CommandBars("Reviewing").Visible = 0
        .CommandBars(2).Visible = Show
    End With

End Sub

Private Function CountVisibleSheets() As Byte
    Dim ws
    For Each ws In ThisWorkbook.Sheets
        If ws.Visible Then CountVisibleSheets = CountVisibleSheets + 1
    Next
End Function

Private Function GetMyDocumentsPath$()
    On Error GoTo NotFound
    GetMyDocumentsPath = Environ("UserProfile") & "\My Documents" 'use hidden "my documents" folder
    Exit Function
NotFound:
    'set path here
    GetMyDocumentsPath = "C:\" 'use regular "my documents" folder instead
End Function



This goes in the Workbook object:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Call myWBBeforeSave(SaveAsUI, Cancel)
End Sub

Private Sub Workbook_Open()
    Call myWBOpen
End Sub

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
    ShowUI (False)
End Sub
 
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
    If Range("ShowNumbersAsTextErrors") Then Application.ErrorCheckingOptions.NumberAsText = 1
    ShowUI (True)
End Sub