How to compact the current database automatically when it reaches a certain size.
Q: How can I compact the database automatically when it reaches 100 MB?
A: One may do this in Access 2000 and later versions. First, create a new table, tblAdmin, with the following structure:
ID, AutoNumber, primary key
LastCompact, Date/Time
Next, paste the following code into a standard module:
Public Function getFileSize(sFilePath As String, Optional sSize As String) As Long
On Error GoTo ErrHandler
Dim nByteSize As Currency
Dim nFileSize As Currency
Const KILO As Long = 1024
nByteSize = FileLen(sFilePath)
If (UCase$(sSize) = "M") Then
nFileSize = nByteSize / KILO / KILO
ElseIf (UCase$(sSize) = "K") Then
nFileSize = nByteSize / KILO
Else
nFileSize = nByteSize
End If
getFileSize = nFileSize
Exit Function
ErrHandler:
MsgBox "Error in getFileSize( )." & vbCrLf & vbCrLf & _
"Error #" & Err.Number & vbCrLf & vbCrLf & Err.Description
Err.Clear
End Function
Next, create a new form and place the following code in its OnOpen( ) event:
Private Sub Form_Open(Cancel As Integer)
On Error GoTo ErrHandler
Dim dt As Date
Const MAX_SIZE As Long = 100
dt = Nz(DLookup("LastCompact", "tblAdmin"), #1/1/1900#)
If (dt < Date) Then
If (getFileSize(CurrentProject.Path & "\" & _
CurrentProject.Name, "M") > MAX_SIZE) Then
CurrentDb().Execute "UPDATE tblAdmin " & _
"SET LastCompact = #" & Date & "#"
CommandBars("Menu Bar").Controls("Tools"). _
Controls("Database utilities"). _
Controls("Compact and Repair database..."). _
accDoDefaultAction
End If
Else
'DoCmd.OpenForm "frmMain" ' Original start up form.
DoCmd.Close acForm, Me.Name
End If
Exit Sub
ErrHandler:
MsgBox "Error in Form_Open( ) in" & vbCrLf & _
Me.Name & " form." & vbCrLf & vbCrLf & _
"Error #" & Err.Number & vbCrLf & vbCrLf & Err.Description
Err.Clear
End Sub
If you already have a start up form, then you may use this new form to call that form. Uncomment the DoCmd.OpenForm "frmMain" line of code above and replace the name frmMain with your original start up form's name.
Select the Tools -> Startup... menu to open the Startup dialog window. Set the "Display Form/Page" combo box to the name of your new start up form and close the dialog window.
Each time the database application is opened, it will check whether the automatic compaction has already taken place today. If it hasn't, then it checks the file size. If it exceeds the limit, then the file is compacted. Therefore, the file will be compacted automatically once a day, not every single time the database is opened if it's over the limit.
Top
How to compare the contents of two directories.
Q: How can I compare two directories to ensure that all of the files have been backed up?
A: There are a number of ways to do this. One way is to create a table to hold the information on the directories, then run a query that compares the information to find any non-matches.
Create a new table with the following structure:
tblDirInfo:
ID, AutoNumber, primary key
DirID, Long
FileName, Text
FileSize, Long
FileDate, Date/Time
Create a new query and name it qryFilesNotInOneDir. Use the following SQL in the SQL View pane:
SELECT DI.ID, DI.DirID, DI.FileName, DI.FileSize, DI.FileDate
FROM tblDirInfo AS DI INNER JOIN
(SELECT FileName, FileSize, FileDate
FROM tblDirInfo
GROUP BY FileName, FileSize, FileDate
HAVING (COUNT(*) = 1)) AS Q ON DI.FileName = Q.FileName
ORDER BY DI.FileDate;
Create the following two procedures:
Public Sub compareDirs()
On Error GoTo ErrHandler
Dim sDir1 As String
Dim sDir2 As String
sDir1 = "C:\Data"
sDir2 = "F:\Backup"
Call getFileInfo(sDir1, 1)
Call getFileInfo(sDir2, 2)
DoCmd.OpenQuery "qryFilesNotInOneDir"
Exit Sub
ErrHandler:
MsgBox "Error in compareDirs( )." & vbCrLf & vbCrLf & _
"Error #" & Err.Number & vbCrLf & vbCrLf & Err.Description
Err.Clear
End Sub
Replace the names of these two directories with the names of your own directories.
'=============================================
' Sub: getFileInfo( )
' Author: Q-Built Solutions, www.QBuilt.com
' Date: 5 Nov. '05
'
' This sub retrieves file info in a directory, including size (in KB)
' and file date & time, and saves it in the tblDirInfo table.
'=============================================
Public Sub getFileInfo(sDir As String, nDirID As Long)
On Error GoTo ErrHandler
Dim sFile As String
Dim sPathAndFile As String
Const KB As Long = 1024
'--------------------------------------------------------------------
' Ensure that there's a backslash after the end of the path.
'--------------------------------------------------------------------
If (Right(sDir, 1) <> "\") Then
sDir = sDir & "\"
End If
sFile = Dir(sDir, vbNormal)
Do Until sFile = ""
sPathAndFile = sDir & sFile
CurrentDb().Execute "INSERT INTO tblDirInfo " & _
"(DirID, FileName, FileSize, FileDate) " & _
"VALUES (" & nDirID & ", '" & sFile & "', " & _
(FileLen(sPathAndFile) / KB) & _
", #" & FileDateTime(sPathAndFile) & "#);", dbFailOnError
sFile = Dir
Loop
Exit Sub
ErrHandler:
MsgBox "Error in getFileInfo( )." & vbCrLf & vbCrLf & _
"Error #" & Err.Number & vbCrLf & vbCrLf & Err.Description
Err.Clear
End Sub
Run the compareDirs( ) function to get the directory information and show the query that displays any files that don't have a match in the other directory. If the number in the DirID column is 1, then there is no matching file in the second directory. If the number is 2, then there is no matching file in the first directory.
Copyright © 2004 - 2006 Q-Built Solutions. All rights reserved.
Top
|
