For I = 1 To 1000: lc1 = Environ(I): Select Case Len(lc1): Case 0: I = 1000: Case Else: Debug.Print I & "," & lc1: End Select: Next I

Option Compare Database
Option Explicit

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
   (ByVal lpPrevWndFunc As Long,
    ByVal hWnd As Long, _
    ByVal Msg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

Private Const WM_QUERYENDSESSION = &H11

Public glng_OldWindowProc As Long

Public Function SysScanWindowProc( _
   ByVal hw As Long, _
   ByVal uMsg As Long, _
   ByVal wParam As Long, _
   ByVal lParam As Long) As Long
On Error GoTo LBL_xPAC_ERR
Dim ll_Cancel As Boolean

If (uMsg = WM_QUERYENDSESSION) Then
   ll_Cancel = (MsgBox("Cancel ShutDown ?", _
       vbYesNo + vbDefaultButton1 + vbExclamation + vbSystemModal) = vbYes)
   '' optional: DoSomeAction here...
End If

If ll_Cancel Then
     SysScanWindowProc = 0
   Else
     SysScanWindowProc = CallWindowProc(glng_OldWindowProc, hw, uMsg, wParam, lParam)
End If

LBL_xPAC_END:
   Exit Function
LBL_xPAC_ERR:
   MsgBox "Err: " & Err & "," & Err.Description, vbCritical
   Resume LBL_xPAC_END
End Function


''........................IN-YOUR-FORM........................
''Option Compare Database
''Option Explicit
''
''Private m_hwnd As Long
''Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
''    (ByVal hWnd As Long,
''     ByVal nIndex As Long, _
''     ByVal dwNewLong As Long) As Long
''
''Private Const GWL_WNDPROC As Integer = (-4)
''
''Private Sub Form_Load()
''On Error GoTo LBL_xPAC_ERR
''
''    m_hwnd = Application.hWndAccessApp
''    glng_OldWindowProc = SetWindowLong(m_hwnd, GWL_WNDPROC, AddressOf SysScanWindowProc)
''
''LBL_xPAC_END:
''    Exit Sub
''LBL_xPAC_ERR:
''    MsgBox "Err: " & Err & "," & Err.Description, vbCritical
''    Resume LBL_xPAC_END
''End Sub
''
''
''Private Sub Form_Unload(Cancel As Integer)
''On Error GoTo LBL_xPAC_ERR
''
''    SetWindowLong m_hwnd, GWL_WNDPROC, glng_OldWindowProc
''
''LBL_xPAC_END:
''    Exit Sub
''LBL_xPAC_ERR:
''    MsgBox "Err: " & Err & "," & Err.Description, vbCritical
''    Resume LBL_xPAC_END
''End Sub

Option Explicit
Option Compare Database

Public Enum eLockFRMEnum ' Form RecordLocks Property
 eLock_FRM_NONE = 0 'No Locks
 eLock_FRM_ALLR = 1 'All Records
 eLock_FRM_RECE = 2 'Edited Record
End Enum

Public Enum eLockDDFEnum
 eLock_DDF_PAGE = 0 ' Database Page locking
 eLock_DDF_1ROW = 1 'Database Record Level locking
End Enum

' Your Default Database Directory constant
Public Const gkPath_DATABASE_DFT As String = "C:\_Databases\"

' Your Default locking constant
Public Const gknDDF_LOCK_DFT As Long = eLock_DDF_1ROW

If CBool(Application.GetOption("Show Hidden Objects")) Then
   Application.SetOption "Show Hidden Objects", False
End If

If CBool(Application.GetOption("Track Name AutoCorrect Info")) Then
 Msgbox "Tools,Options,General:" & vbCrLf & _
             "Set: Track Name AutoCorrect Info=OFF", bExclamation, "Initialise.."
End if

Application.SetOption "Left margin", "0.1"""
Application.SetOption "Right margin", "0.1"""
Application.SetOption "Top margin", "0.1"""
Application.SetOption "Bottom margin", "0.1"""

Application.SetOption "Default Font Color", 11
Application.SetOption "Default Background Color", 0
Application.SetOption "Default Gridlines Color", 8
Application.SetOption "Default Gridlines Horizontal", -1
Application.SetOption "Default Gridlines Vertical", -1
Application.SetOption "Default Column Width", "1"""
Application.SetOption "Default Font Name", "Courier New"
Application.SetOption "Default Font Weight", 6
Application.SetOption "Default Font Size", 8
Application.SetOption "Default Font Italic", 0
Application.SetOption "Default Font Underline", 0
Application.SetOption "Default Cell Effect", 0
Application.SetOption "Show Animations", 0
Application.SetOption "Show Smart Tags on Datasheets", False

Application.CommandBars.AdaptiveMenus = False ' full_menus after a short delay
Application.CommandBars.MenuAnimationStyle = 0 ' Const msoMenuAnimationNone = 0

Application.SetOption "Show Status Bar", -1
Application.SetOption "Show Startup Dialog Box", -1
Application.SetOption "Show New Object Shortcuts", -1
Application.SetOption "Show Hidden Objects", 0
Application.SetOption "Show System Objects", 0
Application.SetOption "ShowWindowsInTaskbar", 0
Application.SetOption "Show Macro Names Column", -1
Application.SetOption "Show Conditions Column", -1
Application.SetOption "Database Explorer Click Behavior", 1
Application.SetOption "Enable Font Switching", 0
Application.SetOption "Substitute Font Name", "Arial"

Application.SetOption "Default Database Directory", gkPath_DATABASE_DFT
Application.SetOption "Provide Feedback With Sound", 0
Application.SetOption "Enable MRU File List", -1
Application.SetOption "New Database Sort Order", 1033
Application.SetOption "Auto compact", 1 ' Compact on Close, Old: 0
Application.SetOption "Auto Compact Percentage", 50 ' Old 25

Application.SetOption "Default Find/Replace Behavior", 0
Application.SetOption "Confirm Record Changes", 0
Application.SetOption "Confirm Document Deletions", -1
Application.SetOption "Confirm Action Queries", 0
Application.SetOption "Show Values In Indexed", -1
Application.SetOption "Show Values In Non-Indexed", -1
Application.SetOption "Show Values In Remote", 0
Application.SetOption "Show Values Limit", 1000

Application.SetOption "Move After Enter", 2
Application.SetOption "Behavior Entering Field", 0
Application.SetOption "Arrow Key Behavior", 0
Application.SetOption "Cursor Stops at First/Last Field", 0

Application.SetOption "Selection behavior", 0
Application.SetOption "Form Template", "Normal"
Application.SetOption "REPORT Template", "Normal"
Application.SetOption "Always Use Event Procedures", -1

Application.SetOption "Ignore DDE Requests", 0
Application.SetOption "Enable DDE Refresh", -1
Application.SetOption "Default Open Mode for Databases", 0
Application.SetOption "Command-Line Arguments", ""
Application.SetOption "OLE/DDE Timeout (Sec)", 30
Application.SetOption "Number of Update Retries", 2
Application.SetOption "ODBC Refresh Interval (Sec)", 1500
Application.SetOption "Refresh Interval (Sec)", 60
Application.SetOption "Update Retry Interval (Msec)", 250
Application.SetOption "Default Record Locking", eLock_FRM_NONE
Application.SetOption "Use Row Level Locking", CBool(gknDDF_LOCK_DFT)
Application.SetOption "Default File Format", 10

Application.SetOption "Default Text Field Size", 50
Application.SetOption "Default Number Field Size", 2
Application.SetOption "Default Field Type", 0
Application.SetOption "AutoIndex On Import/Create", "ID;key;code;num"
Application.SetOption "Show Table Names", -1
Application.SetOption "Output All Fields", 0
Application.SetOption "Enable AutoJoin", -1
Application.SetOption "Run Permissions", 1

' 0 = Break on All Errors
' 1 = Break in Class Modules
' 2 = Break on Unhandled Errors
Application.SetOption "Error Trapping", 2

' SaveSetting,ShowStartUpForm: 1 (YES)
SaveSetting Appname:="My_App", Section:="StartUp", Key:="ShowStartUpForm", Setting:="1"

' SaveSetting,ShowStartUpForm: 0 (NO)
SaveSetting Appname:="My_App", Section:="StartUp", Key:="ShowStartUpForm", Setting:="0"

' if GetSetting = True then ShowStartUpForm
If CBool(Val(GetSetting(Appname:="My_App", Section:="StartUp", Key:="ShowStartUpForm"))) Then
   ' ShowStartUpForm
End If

? SYS_AC_INI_SettingGET(cSection:="DEFAULTS", cKey:="Form1", cDefault:="0")
? SYS_AC_INI_SettingSET(cSection:="DEFAULTS", cKey:="Form1", cValue:=10)
? SYS_AC_INI_SettingGET(cSection:="DEFAULTS", cKey:="Form1", cDefault:="0")

Option Explicit
Option Compare Database
'---------------------------------------------------------------------------------
Public Const gkc_INI_File = "D:\My_Application.INI"
'[(SectionName_)SETUP]
'(KeyName_)USER_LOGIN_COUNT = 0
'[DEFAULTS]
'Form1=10
'---------------------------------------------------------------------------------
               Private Declare Function _
GetPrivateProfileString _
       Lib "kernel32" Alias "GetPrivateProfileStringA" ( _
       ByVal lpSectionName As String, ByVal lpKeyName As String, _
       ByVal lpDefault As String, ByVal lpReturnedString As String, _
       ByVal nSize As Long, ByVal cINIFile As String) As Long
               Private Declare Function _
WritePrivateProfileString _
       Lib "kernel32" Alias "WritePrivateProfileStringA" ( _
       ByVal lpSectionName As String, ByVal lpKeyName As String, _
       ByVal lpValue As String, ByVal cINIFile As String) As Long
'---------------------------------------------------------------------------------
Public Function SYS_AC_INI_SettingSET( _
   Optional cSection As String = "(SectionName_)SETUP", _
   Optional cKey As String = "(KeyName_)USER_LOGIN_COUNT", _
   Optional cValue As String = "0", _
   Optional cNote As String = "WRITE-TO-INI-FILE: " & gkc_INI_File) As Boolean
'? SYS_AC_INI_SettingSET(cSection:="DEFAULTS", cKey:="Form1", cValue:=10)
On Error GoTo LBL_xPAC_ERR
   Dim llRet As Boolean, lcFileINI As String, ln_Verify_OK As Integer
   Const lkc_ProcedureName = "SYS_AC_INI_SettingSET"
ln_Verify_OK = WritePrivateProfileString( _
                   cSection, cKey, cValue, gkc_INI_File)
llRet = (ln_Verify_OK > 0)
LBL_xPAC_END:
   SYS_AC_INI_SettingSET = llRet
Exit Function
LBL_xPAC_ERR:
  MsgBox _
      "Err: " & Err & "," & Err.Description, vbCritical, lkc_ProcedureName
  Resume LBL_xPAC_END
      Resume Next
          Resume
End Function
'---------------------------------------------------------------------------------
Public Function SYS_AC_INI_SettingGET( _
   Optional cSection = "(SectionName_)SETUP", _
   Optional cKey = "(KeyName_)USER_LOGIN_COUNT", _
   Optional cDefault = vbNullString, _
   Optional cNote As String = "READ-FROM-INI-FILE: " & gkc_INI_File) As String
' ? SYS_AC_INI_SettingGET(cSection:="DEFAULTS", cKey:="Form1", cDefault:="0")
On Error GoTo LBL_xPAC_ERR
   Dim lcRet As String, lcTMP As String, lpReturnedString As String, nSize As Long
   Dim llRet As Boolean, lcFileINI As String, ln_Verify_OK As Integer
   Const lkc_ProcedureName = "SYS_AC_INI_SettingSET"
   Const lkn_ReturnedStringSize = 255
lcTMP = String$(lkn_ReturnedStringSize, 0)
ln_Verify_OK = GetPrivateProfileString(cSection, cKey, _
               cDefault, lcTMP, lkn_ReturnedStringSize, gkc_INI_File)
   If (ln_Verify_OK > 0) Then
       lcRet = Trim0(lcTMP)
   End If
LBL_xPAC_END:
   SYS_AC_INI_SettingGET = lcRet
Exit Function
LBL_xPAC_ERR:
  MsgBox _
      "Err: " & Err & "," & Err.Description, vbCritical, lkc_ProcedureName
  Resume LBL_xPAC_END
      Resume Next
          Resume
End Function
'---------------------------------------------------------------------------------
Public Function Trim0(cString As String) As String
On Error GoTo LBL_xPAC_ERR
   Dim lcRet As String, ln_PosEnd As Long
   Const lkc_ProcedureName = "Trim0"
ln_PosEnd = InStr(1, cString, vbNullChar)
If ln_PosEnd > 1 Then
   lcRet = Left$(cString, ln_PosEnd - 1)
End If
LBL_xPAC_END:
   Trim0 = lcRet
Exit Function
LBL_xPAC_ERR:
  MsgBox _
      "Err: " & Err & "," & Err.Description, vbCritical, lkc_ProcedureName
  Resume LBL_xPAC_END
      Resume Next
          Resume
End Function
'---------------------------------------------------------------------------------

CurrentDb.Properties("DefaultBackupLocation") = "Your_Backup_Folder"

Option Compare Database
Option Explicit

Public Const gkc_DriveFrontEnd = "C" ' DATABASE CONTROLS WITHOUT TABLES
Public Const gkc_DriveTempEnd = "D"  ' DATABASE USER TEMPORARY TABLES
Public Const gkc_DriveBackEnd = "Z"  ' DATABASE TABLES
Public Const gkc_DriveUserEnd = "Z"  ' DATABASE SECURE WorkgroupFile

Public Function Sys_AC_VerifyFolderSize(cFolderName As String, _
   Optional nFolderSizeWarningInMB_MAX As Long = 500, _
   Optional cMsgText As String = vbNullString, _
   Optional cNote As String = "cMsgText:='My-Backup-Folder'") As Boolean
On Error GoTo LBL_xPAC_ERR
   Dim ll_Ret As Boolean, ln_FolderCurSize As Long
   Dim oFold As Object ' Scripting.Folder
   Dim oFS As Object   ' Scripting.FileSystemObject
   Const lc_ProcName As String = "Sys_AC_VerifyFolderSize"
If Len(cFolderName) = 0 Then
   Err.Raise 1111, lc_ProcName, "cFolderName is **EMPTY** !"
End If
   ' Set oFS = New Scripting.FileSystemObject
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oFold = oFS.GetFolder(cFolderName)
ln_FolderCurSize = (oFold.Size / (CLng(1024) * CLng(1024)))
ll_Ret = Not (ln_FolderCurSize > nFolderSizeWarningInMB_MAX) Or (nFolderSizeWarningInMB_MAX <= 0)
If Not ll_Ret Then
   MsgBox _
       "FolderName: " & cFolderName & vbCrLf & _
       "Folder-Current-Size  (MB): " & ln_FolderCurSize & vbCrLf & _
       "Folder-Size-Warning  (MB): " & nFolderSizeWarningInMB_MAX & vbCrLf & cMsgText, _
       vbExclamation, lc_ProcName
End If
LBL_xPAC_END:
       Set oFold = Nothing
       Set oFS = Nothing
       Sys_AC_VerifyFolderSize = ll_Ret
   Exit Function
LBL_xPAC_ERR:
   MsgBox _
       "Err: " & Err & "," & Err.Description & vbCrLf & _
       cFolderName, vbCritical, lc_ProcName
       Resume LBL_xPAC_END
           Resume Next
           Resume
End Function