Question

我创建了一个快捷方式，可以打开并压缩我的后端数据库，然后关闭它。

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

我正计划在系统上将此计划任务设置为每天晚上在工作中运行，我假设没有人，但是以防万一有人在打开数据库的情况下离开计算机。

这是我做的捷径：（完美运行） “ ... MSACCESS.EXE”“ ... MyDB.accdb” /紧凑型“ ... \ Back-Ups \ MyDB-Backup.accdb”

我不知道是否存在某种/ ignorewarnings或类似/ compact的快捷方式，这很棒，但是如果没有，是否还有其他方法可以通过vbs或bat文件来实现呢？ / p>

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 OS上运行：

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

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

1 个答案: