' Code courtesy of UtterAccess Wiki
' http://www.utteraccess.com/wiki/index.php/Category:FunctionLibrary
' Original submission by Pacala_Ba
' 2010, August 11th
'
' You are free to use it in any application,
' provided this copyright notice is left unchanged.
'
'
' --------------------- Example calls -----------------
'? Sys_AC_VerifyDriveFreeSpaceInMB(gkc_DriveBackEnd,"BackEnd")
'? Sys_AC_VerifyDriveFreeSpaceInMB( _
                       cDrive:=CurrentProject.FullName, cMsgText:="DriveFrontEnd", _
                       nDriveFreeSpaceWarningInMB_MIN:=9999999, nDriveFreeSpaceAC_QuitInMB_MIN:=200)
'
'Example constants to use for arguments:
'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_VerifyDriveFreeSpaceInMB(cDrive As String, _
  Optional cMsgText As String = "", _
  Optional nDriveFreeSpaceWarningInMB_MIN As Long = 500, _
  Optional nDriveFreeSpaceAC_QuitInMB_MIN As Long = 200, _
  Optional cNote As String = "Input: Drive/Path") As Long
On Error GoTo LBL_xPAC_ERR
Dim ln_Ret As Long, lcDrive As String, ll_AC_EXIT As Boolean
Dim oFS As Object, oDrive As Object
   Const lc_ProcName As String = " Sys_AC_VerifyDriveFreeSpaceInMB.02"
lcDrive = Trim$(Left$(cDrive, 1))
If Len(lcDrive) = 0 Then
  Err.Raise 1000, lc_ProcName, "Drive name is **EMPTY** !"
Else
  Set oFS = CreateObject("Scripting.FileSystemObject")
  Set oDrive = oFS.GetDrive(UCase$(lcDrive))
  ln_Ret = (oDrive.FreeSpace / (CLng(1024) * CLng(1024)))
  If (ln_Ret < nDriveFreeSpaceWarningInMB_MIN) Then
       ll_AC_EXIT = (ln_Ret < nDriveFreeSpaceAC_QuitInMB_MIN)
       MsgBox _
           "DriveName: " & lcDrive & vbCrLf & _
           "Drive-FreeSpace-Current (MB): " & ln_Ret & vbCrLf & _
           "Drive-FreeSpace-Warning (MB): " & nDriveFreeSpaceWarningInMB_MIN & vbCrLf & _
           "Drive-FreeSpace-AC_Quit (MB): " & nDriveFreeSpaceAC_QuitInMB_MIN & vbCrLf & _
           cMsgText, IIf(ll_AC_EXIT, vbCritical, vbExclamation), lc_ProcName
       If ll_AC_EXIT Then
           Application.Quit
       End If
  End If
End If
LBL_xPAC_END:
  Set oFS = Nothing
  Set oDrive = Nothing
Sys_AC_VerifyDriveFreeSpaceInMB = ln_Ret
  Exit Function
LBL_xPAC_ERR:
MsgBox "Err: " & Err & "," & Err.Description, vbCritical, lc_ProcName
  Resume LBL_xPAC_END
  Resume Next
  Resume
End Function