打开数据库时，如何使用vba压缩MS Access数据库 [英] How to compact an MS Access database, while the database is open, using vba

问题描述

我正在运行一些VBA代码模块.在运行过程中，由于Access达到其最大大小2GB，代码崩溃.但是，如果我此时压缩数据库，则只有200MB.

I am running a few modules of VBA code. In the middle of running the code crashes as Access reaches its max size of 2GB; but, if I compress the database at that point it is only 200MB.

代码运行时是否可以定期压缩数据库?

Is it possible to compress the database at regular intervals while the code is running?

推荐答案

我最近偶然发现了这个问题，在这里我在答案中遇到的某些事情是完全错误的:

I recently stumbled into this question, and some things I encounter in answers here are just plain wrong:

1. 您不能在打开时通过VBA压缩和修复访问数据库！无论是否关闭了所有表，是否具有排他锁等.
2. 但是，如果到该数据库的所有连接都已关闭，则可以从链接数据库压缩一个后端.这就是Tony Toews能够成功压实和修复的原因.

1. You CAN'T compact and repair an access database through VBA while it's open! No matter if all tables are closed, if you have an exclusive lock, etc.
2. You can, however, compact a backend from a linked database, if all connections to it are closed. This is why Tony Toews could successfully compact and repair.

这很不幸，到目前为止，最简单的解决方法是创建链接数据库.但是，如果这是不可取的，那么如果您愿意做一些奇怪的诡计，则可以做另一件事.

This is unfortunate, and the easiest workaround by far is to create a linked database. But if this is undesirable, there is one alternate thing you can do, if you're willing to do some weird trickery.

问题在于，压缩和修复发生时必须关闭主数据库.要解决此问题，我们可以执行以下操作:

The problem is that the main database has to be closed while the compact and repair happens. To work around this, we can do the following:

1. 以编程方式创建VBScript文件
2. 在该文件中添加代码，以便我们压缩&在不打开数据库的情况下修复我们的数据库
3. 打开并异步运行该文件
4. 在契约&之前关闭我们的数据库维修发生了
5. 压缩并修复数据库(创建副本)，删除旧数据库，重命名副本
6. 重新打开我们的数据库，继续进行批处理
7. 删除新创建的文件

Public Sub CompactRepairViaExternalScript()
    Dim vbscrPath As String
    vbscrPath = CurrentProject.Path & "\CRHelper.vbs"
    If Dir(CurrentProject.Path & "\CRHelper.vbs") <> "" Then
        Kill CurrentProject.Path & "\CRHelper.vbs"
    End If
    Dim vbStr As String
    vbStr = "dbName = """ & CurrentProject.FullName & """" & vbCrLf & _
    "resumeFunction = ""ResumeBatch""" & vbCrLf & _
    "Set app = CreateObject(""Access.Application"")" & vbCrLf & _
    "Set dbe = app.DBEngine" & vbCrLf & _
    "Set objFSO = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf & _
    "On Error Resume Next" & vbCrLf & _
    "Do" & vbCrLf & _
    "If Err.Number <> 0 Then Err.Clear" & vbCrLf & _
    "WScript.Sleep 500" & vbCrLf & _
    "dbe.CompactDatabase dbName, dbName & ""_1""" & vbCrLf & _
    "errCount = errCount + 1" & vbCrLf & _
    "Loop While err.Number <> 0 And errCount < 100" & vbCrLf & _
    "If errCount < 100 Then" & vbCrLf & _
    "objFSO.DeleteFile dbName" & vbCrLf & _
    "objFSO.MoveFile dbName & ""_1"", dbName" & vbCrLf & _
    "app.OpenCurrentDatabase dbName" & vbCrLf & _
    "app.UserControl = True" & vbCrLf & _
    "app.Run resumeFunction" & vbCrLf & _
    "End If" & vbCrLf & _
    "objFSO.DeleteFile Wscript.ScriptFullName" & vbCrLf
    Dim fileHandle As Long
    fileHandle = FreeFile
    Open vbscrPath For Output As #fileHandle
    Print #fileHandle, vbStr
    Close #fileHandle
    Dim wsh As Object
    Set wsh = CreateObject("WScript.Shell")
    wsh.Run """" & vbscrPath & """"
    Set wsh = Nothing
    Application.Quit
End Sub

这将执行上面概述的所有步骤，并通过在调用此函数的数据库上调用ResumeBatch函数来恢复批处理(不带任何参数).

This does all the steps outlined above, and resumes the batch by calling the ResumeBatch function on the database that called this function (without any parameters).

请注意，点击运行保护和不喜欢vbscript文件的防病毒/策略之类的东西可能会破坏这种方法.

Note that things like click-to-run protection and antivirus/policy not liking vbscript files can ruin this approach.

这篇关于打开数据库时，如何使用vba压缩MS Access数据库的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！