UtterAccess HomeUtterAccess Wiki

Welcome Guest ( Log In | Register )

Custom Search
Edit Discussion
> Sys AC VerifyDbMaxSize    
CODE

' Code courtesy of UtterAccess Wiki
' http://www.utteraccess.com/wiki/index.php/Category:FunctionLibrary
' Original submission by Pacala_Ba
' 2010, August 10th
'
' You are free to use it in any application,
' provided this copyright notice is left unchanged.
'
' --------------------- Example calls -----------------
'Sys_AC_VerifyDbMaxSize CurrentProject.FullName,30 ,2000,"FrontEnd"
'Sys_AC_VerifyDbMaxSize "D:\BackEnd_PATH\BackEnd_DATABASE.mdb", 1000 ,2000,"BackEnd"
'Sys_AC_VerifyDbMaxSize "D:\TempEnd_PATH\TempEnd_DATABASE.mdb", 1000 ,2000,"TempEnd"
'
'
Public Sub Sys_AC_VerifyDbMaxSize( _
  Optional cDatabaseFullName As String, _
  Optional nDbFileSizeWarningInMB_MAX As Long = 20, _
  Optional nDbFileSizeAC_QuitInMB_MAX As Long = 2000, _
  Optional cMsgText As String = "", _
  Optional cNote As String = vbCrLf & "Recommended Values " & vbCrLf & _
  "FrontEnd       :    20-100 MB" & vbCrLf & _
  "BackEnd/TempEnd: 1000-1500 MB" & vbCrLf & _
  "Limit-MAX      :      2048 MB /2 GB")
On Error GoTo LBL_xPAC_ERR

Dim ln_DbFileSizeInMB_Cur As Long, lc_FileName As String, ll_AC_EXIT As Boolean

lc_FileName = cDatabaseFullName

If Len(lc_FileName) = 0 Then
  lc_FileName = CurrentProject.FullName ' DEFAULT DATABASE
End If

If Len(Dir(lc_FileName, vbNormal Or vbHidden)) = 0 Then
  Err.Raise 1000, "Sys_AC_VerifyDbMaxSize", lc_FileName & ", FILE NOT FOUND !"
End If

ln_DbFileSizeInMB_Cur = CInt(FileLen(lc_FileName) / (CLng(1024) * CLng(1024)))

If (ln_DbFileSizeInMB_Cur > nDbFileSizeWarningInMB_MAX) Or (nDbFileSizeWarningInMB_MAX <= 0) Then

  ll_AC_EXIT = (ln_DbFileSizeInMB_Cur > nDbFileSizeAC_QuitInMB_MAX)

  MsgBox "Compact Database.." & vbCrLf & _
  "Database-Current-Size(MB): " & ln_DbFileSizeInMB_Cur & vbCrLf & _
  "Db-Max-Size-Warning  (MB): " & nDbFileSizeWarningInMB_MAX & vbCrLf & _
  "Db-Max-Size-AC_Quit  (MB): " & nDbFileSizeAC_QuitInMB_MAX & vbCrLf & _
  "Db-FileName: " & lc_FileName & vbCrLf & cMsgText, _
  IIf(ll_AC_EXIT, vbCritical, vbExclamation), "Sys_AC_VerifyDbMaxSize"

  If ll_AC_EXIT Then
      Application.Quit
  End If
End If

LBL_xPAC_END:
  Exit Sub
LBL_xPAC_ERR:
MsgBox "Err: " & Err & "," & Err.Description, vbCritical, "Sys_AC_VerifyDbMaxSize"
  Resume LBL_xPAC_END
  Resume Next
  Resume
End Sub


Creative Commons License
Sys AC VerifyDbMaxSize by UtterAccess Wiki is licensed under a Creative Commons Attribution-ShareAlike 3.0 Unported License.
Editing and revision of the content is freely encouraged; for details, see Expected Usage.

Edit Discussion
Custom Search
Thank you for your support!
This page has been accessed 2,908 times.  This page was last modified 09:42, 6 April 2011 by Jack Leach.   Disclaimers