在快捷方式上压缩和修复后端数据库

Question

我创建了一个快捷方式，用于打开和压缩我的后端数据库，然后将其关闭。

问题是，如果有人打开了数据库，它会引发用户正在使用数据库的警告。有什么方法可以忽略该警告并关闭程序吗？

我计划在我的系统上将此作为计划任务，每天晚上在工作时运行，我认为不会有人这样做，但以防万一有人在数据库打开的情况下将计算机打开。

这是我制作的快捷方式：（完美运行） "...MSACCESS.EXE" "...MyDB.accdb" /compact "...\Back-Ups\MyDB-Backup.accdb"

我不知道是否有某种 /ignorewarnings 或类似 /compact 之类的快捷方式，这会很棒，但如果没有，是否有任何其他方法可以使用 vbs 或 bat 文件执行此操作？

Answer 1

带有MS Access 的主机的变体。简单DoCompact.cmd脚本文件：

@SET TargetFile=C:\Database1.accdb
@SET ldbFile=C:\Database1.laccdb
@SET AccessExe="c:\Program Files (x86)\Microsoft Office\Office14\MSACCESS.EXE"

@IF EXIST %ldbFile% (
@del %ldbFile%
)
@IF NOT EXIST %ldbFile% (
@%AccessExe% %TargetFile% /compact
)

.mdb 数据库的变体，未安装 MS Access。 C:\DoCompact.vbs 应该通过命令%windir%\SysWOW64\cscript C:\DoCompact.vbs 在 64 操作系统上运行的脚本文件：

Option Explicit 
Dim logFile 

logFile = "\\srv\Work\compact.log"
Log2File ""
CompactDB "\\srv\Work\Db.mdb", ""
CompactDB "\\srv\Work\DbWithPassword.mdb", "Password"

Sub CompactDB(databaseName, passwd)
    Dim ldbName 
    Dim tempName
    Dim oldName
    Dim objFSO
    Dim Engine
    Dim needToRevert
    Dim trouble
    Dim initialSize
    Dim resultSize
    Dim percent

    logFile = Left(databaseName, InStrRev(databaseName,"\") ) & "\compact.log"
    ldbName = Left(databaseName, Len(databaseName)-3) & "ldb"
    tempName = databaseName & "_compact"
    oldName =  databaseName & "_old"
    initialSize = GetFileSize(databaseName)
    Log2File "Compacting STARTed for " & databaseName & " initial size = " & FormatNumber(initialSize, 0, 0, 0, -1)

    If not(RemoveIfExists(ldbName) And RemoveIfExists(tempName) And (RemoveIfExists(oldName))) Then
        Log2File "Compacting CANCELed because of some file was locked " & databaseName
        Exit Sub
    End If

    Set objFSO = CreateObject("Scripting.FileSystemObject") 

    ' 1 compact to temp
    Set Engine = CreateObject("JRO.JetEngine")
    Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & databaseName & ";Jet OLEDB:Database Password=" & passwd , _
                           "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & tempName & ";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Password=" & passwd

    On Error resume Next
        needToRevert = False
        If objFSO.FileExists(tempName)  Then
            ' 2 rename source to _old
            objFSO.MoveFile databaseName , oldName
            needToRevert = (needToRevert Or (Err.Number <> 0) Or (Not objFSO.FileExists(oldName) ))
        End If

        If Not needToRevert Then
            ' 3 rename temp to source
            objFSO.MoveFile tempName, databaseName
            needToRevert = (needToRevert Or (Err.Number <> 0) Or (Not objFSO.FileExists(databaseName)))
        End If

        If Not needToRevert Then
            ' 4 remove _old
            objFSO.DeleteFile(oldName)
            resultSize = GetFileSize(databaseName)
            percent = resultSize / initialSize 
            Log2File "Compacting done OK for " & databaseName & " result size  = " & FormatNumber(resultSize, 0, 0, 0, -1) & " (" & FormatPercent(percent, 1, -1) & ")"
        Else
            ' RESTORE source from _old if there were errors
            objFSO.MoveFile oldName, databaseName 
            Log2File "Compacting FAILed for " & databaseName
        End If
    On Error GoTo 0 
End Sub

Sub Log2File(message)
    Dim objFSO 
    Dim objFile
    Dim objTS
    Dim messageString
    On Error Resume Next    
        messageString = Now() & " : " & message

        WScript.Echo messageString 

        Set objFSO = CreateObject("Scripting.FileSystemObject")

        If Not objFSO.FileExists(logFile) Then
            Set objFile = objFSO.CreateTextFile(logFile)
            objFile.Close  
        End If
        Set objTS = objFSO.OpenTextFile(logFile, 8 ) ' FOR_APPENDING = 8
        objTS.WriteLine messageString
        objTS.Close 
    On Error GoTo 0 
End Sub

Function RemoveIfExists(fileName)
    Dim objFSO

    RemoveIfExists = False
    Set objFSO = CreateObject("Scripting.FileSystemObject") 
    If objFSO.FileExists(fileName) Then 
        ' try to remove and if fail - we can't do anything else
        err.Clear
        On Error resume Next
            objFSO.DeleteFile fileName, True
        On Error GoTo 0         
        If (Err.Number <> 0) or (objFSO.FileExists(fileName)) Then
            Log2File "Error while try to remove " & fileName & " file :" & Err.Description 
            Err.Clear
            Exit Function
        End If

    End If
    RemoveIfExists = True
End Function

Function GetFileSize(fileName)
    Dim objFSO
    Dim objFile
    on Error resume next    
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objFile = objFSO.GetFile(fileName)
        GetFileSize = objFile.Size 
    On Error GoTo 0
End Function