你可以在关闭数据库的任何时候进行压缩关闭。这是非常简单的;只要勾选方框@我知道,实际上没有具体的时间来执行C/R,但是制定一个定期的时间表是件好事,不管是一天一次,一周一次,还是一个月一次。
这里有一个关闭时的压缩版本,您可以使用Windows任务调度程序定期运行它。您基本上是从另一个数据库控制一个数据库。我以前在一个以前的咨询公司工作时,常常在一夜之间运行这些流程。它工作了一年多。
Option Compare Database
Option Explicit
' Declare an enumeration of long integer
' constants, to be used as the return values
' for the RepairDatabase() function.
' As Access's CompactRepair() method returns
' TRUE or FALSE, the Enum uses -1 (TRUE) for
' success and 0 for failure.
Public Enum ryCompactResult
cmpCompactSuccessful = -1
cmpCompactFailed = 0
cmpErrorOccurred = 1
cmpSourceFileDoesNotExist = 2
cmpInvalidSourceFileNameExtension = 3
cmpDestinationFileExists = 4
End Enum
Private Sub TestRepair()
Dim strSource As String
Dim strDestination As String
Dim lngRetVal As ryCompactResult
strSource = "C:\MyFolder\db1.mdb"
strDestination = "C:\MyFolder\db2.mdb"
' Call the function:
lngRetVal = RepairDatabase(strSource, strDestination)
' Examine the return value from the function
' and display appropriate message:
Select Case lngRetVal
Case cmpCompactSuccessful
MsgBox "Compact & repair successful.", _
vbOKOnly + vbInformation, _
"Program Information"
Case cmpSourceFileDoesNotExist
MsgBox strSource & vbNewLine & vbNewLine _
& "The above file does not exist.", _
vbOKOnly + vbExclamation, _
"Program Finished"
Case cmpInvalidSourceFileNameExtension
MsgBox strSource & vbNewLine & vbNewLine _
& "The above file has an invalid filename " _
& "extension.", vbOKOnly + vbExclamation, _
"Program Finished"
Case cmpDestinationFileExists
MsgBox strDestination & vbNewLine & vbNewLine _
& "The above destination file exists. " _
& vbNewLine _
& "Please delete the above file or " _
& "use a different destination filename.", _
vbOKOnly + vbExclamation, "Program Finished"
Case cmpErrorOccurred
' The RepairDatabase() function has
' already displayed an error message.
End Select
End Sub
Function RepairDatabase( _
strSource As String, _
strDestination As String) As ryCompactResult
' IN:
'
' strSource:
' The full path to the database that is
' to be compacted.
'
' strDestination:
' The full path to the resultant database
' after strSource has been compacted.
'
' OUT:
'
' This function returns one of the values in
' the ryCompactResult Enum.
Dim lngRetVal As ryCompactResult
Dim strFileName As String
Dim strFileNameExtn As String
Dim lngPos As Long
On Error GoTo Error_RepairDatabase
' See if source file exists:
strFileName = Dir(strSource)
If Len(strFileName) = 0 Then
lngRetVal = cmpSourceFileDoesNotExist
GoTo Exit_RepairDatabase
End If
' See if source filename has appropriate
' filename extension (mdb or accdb).
' First, see if filename contains a period:
lngPos = InStr(strFileName, ".")
If lngPos = 0 Then
' Period not found in filename;
' i.e. no filename extension found.
lngRetVal = cmpInvalidSourceFileNameExtension
GoTo Exit_RepairDatabase
Else
' Get filename extension:
strFileNameExtn = Mid(strFileName, lngPos + 1)
strFileNameExtn = LCase(strFileNameExtn)
Select Case strFileNameExtn
Case "mdb", "accdb"
' Correct filename extension found.
' We can proceed with compact & repair.
Case Else
' Invalid filename extension found.
lngRetVal = cmpInvalidSourceFileNameExtension
GoTo Exit_RepairDatabase
End Select
End If
' Destination file must not exist:
strFileName = Dir(strDestination)
If Len(strFileName) > 0 Then
lngRetVal = cmpDestinationFileExists
GoTo Exit_RepairDatabase
End If
' Compact and repair database:
lngRetVal = Application.CompactRepair( _
strSource, strDestination, True)
Exit_RepairDatabase:
RepairDatabase = lngRetVal
Exit Function
Error_RepairDatabase:
lngRetVal = cmpErrorOccurred
MsgBox "Error No: " & Err.Number _
& vbNewLine & vbNewLine _
& Err.Description, _
vbOKOnly + vbExclamation, _
"Error Information"
Resume Exit_RepairDatabase
End Function
***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** *****
Compact / Repair function below, but not advisable to do arbitrarily on every close - just replace/remove my on error code with your own
Function RepairDatabase(strSource As String, _
strDestination As String) As Boolean
' Input values: the paths and file names of
' the source and destination files.
Dim strSource As String
Dim strDestination As String
strSource = "\\Dg\Debt \2010\Summary\Summary.mdb"
strDestination = "\\Dg\Debt \2010\Summary\Summary_Compact.mdb"
' Trap for errors.
On Error GoTo ErrorRoutine
' Compact and repair the database. Use the return value of
' the CompactRepair method to determine if the file was
' successfully compacted.
RepairDatabase = _
Application.CompactRepair( _
LogFile:=True, _
SourceFile:=strSource, _
DestinationFile:=strDestination)
' Reset the error trap and exit the function.
On Error GoTo 0
Exit Function
' Return False if an error occurs.
Exit_Function:
Exit Function
ErrorRoutine:
RepairDatabase = False
Call LogError(Err.Number, Err.Description, conMod & ".RepairDatabase", , True)
Resume Exit_Function
End Function
Call the function as such:
Call RepairDatabase(strSource, strDestination)
*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
I donât think you can run the compact/repair code in DB#2, which is the DB that I want to do the operation on. So, in DB#1, I tried this behind a Form:
Private Sub Form_Load()
Call RepairDatabase(strSource, strDestination)
End Sub
I put this in a module:
'Compact & Repair
Function RepairDatabase(strSource As String, strDestination As String) As Boolean
Dim strSource As String
Dim strDestination As String
strSource = "\\Dg\Debt \2010\Summary\Summary.mdb"
strDestination = "\\Dg\Debt \2010\Summary\Summary_Compact.mdb"
' Trap for errors.
On Error GoTo ErrorRoutine
' Compact and repair the database. Use the return value of
' the CompactRepair method to determine if the file was
' successfully compacted.
RepairDatabase = _
Application.CompactRepair( _
LogFile:=True, _
SourceFile:=strSource, _
DestinationFile:=strDestination)
' Reset the error trap and exit the function.
On Error GoTo 0
Exit Function
' Return False if an error occurs.
Exit_Function:
Exit Function
ErrorRoutine:
RepairDatabase = False
Call LogError(Err.Number, Err.Description, conMod & ".RepairDatabase", , True)
Resume Exit_Function
End Function
这是一个很好的资源,您可以在有时间的时候通读。
http://www.databasedev.co.uk/compacting-and-repairing-ms-access.html
