MS Access: how to compact current database in VBA

后端 未结 13 1616
慢半拍i
慢半拍i 2020-11-29 07:34

Pretty simple question, I know.

13条回答
  •  再見小時候
    2020-11-29 07:56

    If you have the database with a front end and a back end. You can use the following code on the main form of your front end main navigation form:

    Dim sDataFile As String, sDataFileTemp As String, sDataFileBackup As String
    Dim s1 As Long, s2 As Long
    
    sDataFile = "C:\MyDataFile.mdb"
    sDataFileTemp = "C:\MyDataFileTemp.mdb"
    sDataFileBackup = "C:\MyDataFile Backup " & Format(Now, "YYYY-MM-DD HHMMSS") & ".mdb"
    
    DoCmd.Hourglass True
    
    'get file size before compact
    Open sDataFile For Binary As #1
    s1 = LOF(1)
    Close #1
    
    'backup data file
    FileCopy sDataFile, sDataFileBackup
    
    'only proceed if data file exists
    If Dir(sDataFileBackup vbNormal) <> "" Then
    
            'compact data file to temp file
            On Error Resume Next
            Kill sDataFileTemp
            On Error GoTo 0
            DBEngine.CompactDatabase sDataFile, sDataFileTemp
    
            If Dir(sDataFileTemp, vbNormal) <> "" Then
                'delete old data file data file
                Kill sDataFile
    
                'copy temp file to data file
                FileCopy sDataFileTemp, sDataFile
    
                'get file size after compact
                Open sDataFile For Binary As #1
                s2 = LOF(1)
                Close #1
    
                DoCmd.Hourglass False
                MsgBox "Compact complete " & vbCrLf & vbCrLf _
                    & "Size before: " & Round(s1 / 1024 / 1024, 2) & "Mb" & vbCrLf _
                    & "Size after:    " & Round(s2 / 1024 / 1024, 2) & "Mb", vbInformation
            Else
                DoCmd.Hourglass False
                MsgBox "ERROR: Unable to compact data file"
            End If
    
    Else
            DoCmd.Hourglass False
            MsgBox "ERROR: Unable to backup data file"
    End If
    
    DoCmd.Hourglass False
    

提交回复
热议问题