|
|
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
|
| This page has been accessed 985 times. This page was last modified 09:42, 6 April 2011 by Jack Leach. Disclaimers |