更新时间:2022-11-09 08:22:25
我最近偶然发现了这个问题,在这里我在答案中遇到的某些事情是完全错误的:
I recently stumbled into this question, and some things I encounter in answers here are just plain wrong:
这很不幸,到目前为止,最简单的解决方法是创建链接数据库.但是,如果这是不可取的,那么如果您愿意做一些奇怪的诡计,则可以做另一件事.
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:
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.