数据库中的表和查询在没有任何警告的情况下被删除？

Question

我正在使用 MS Access 2007。

我运行一个例程，它自动对一组查询执行以下操作 一个。删除，b。契约，c。追加

它对外部 MS Access 数据库执行此操作 - 未链接。

有时，我在尝试运行例程时收到错误 3078。

我去查看数据库，发现所有的表和查询都被自动删除了。有谁知道是什么原因造成的？

作为参考，执行查询的例程是：

Public Function execQuery(qry As String, Optional enginePath As String, Optional queryParam As String) As Long

On Error GoTo err_handler
    'Purpose:   Create a log entry for the query being run.
    'Argument:  The query whose execution we are logging.
    'Return:    Primary key value of the log entry. Zero on error.
    'Usage:     For a form, set the On Open property to:    =LogDocOpen([Form])
    '           For a report, set the On Open property to:  =LogDocOpen([Report])
    Dim rs As DAO.Recordset
    Dim lngObjType As Long          'acForm or acReport
    Dim strQry As String            'Name of the query
    Dim startDateTime As Date
    Dim endDateTime As Date
    Dim recordsAffected As Long
    Dim user As String
    Dim compName As String
    Dim dbFullPath As String
    Dim strParam As String
    Dim Dbs As DAO.Database
    Dim QDF As DAO.QueryDef
    Dim objAcc As Access.Application

    If tableExists("TBL_LOG") Then
        Debug.Print "The Table exists"
    Else
        Debug.Print "The table does not exist"
        Debug.Print "Creating Log Table"
        createLogTable
    End If

    strQry = qry
    dbFullPath = enginePath
    strParam = queryParam
    Debug.Print strQry

    Set Dbs = OpenDatabase(dbFullPath, True) 

    Set QDF = Dbs.QueryDefs(strQry)
    If Len(strParam) > 0 Then
        Debug.Print "query: " & strQry
        Debug.Print "Param: " & strParam
        QDF.Parameters("[" & "Param" & "]") = strParam
        startDateTime = Now()
        QDF.Execute dbFailOnError
        endDateTime = Now()
        recordsAffected = QDF.recordsAffected
    Else
        Debug.Print "No Param available"
        startDateTime = Now()
        QDF.Execute dbFailOnError
        endDateTime = Now()
        recordsAffected = QDF.recordsAffected
    End If

        user = NetworkUserName()
        compName = ComputerName()

    If dbLog Then

        Set rs = DBEngine(0)(0).OpenRecordset("TBL_LOG", dbOpenDynaset, dbAppendOnly)
        rs.AddNew
            rs!QueryName = strQry
            rs!RunDateTime = startDateTime
            rs!EndRunDateTime = endDateTime
            rs!ComputerName = compName
            rs!UserName = user
            rs!NumberRecordsAffected = recordsAffected

        rs.Update
        rs.Bookmark = rs.LastModified
        execQuery = rs!ID
        rs.Close
    End If
End sub

压缩的例程：

Public Function RemoteCompact(SourcePath As String, BUPath As String)
Dim KillFile As String
Dim aFilename As Variant
Dim SourceFile As String
Dim BUFile As String

'These lines assign the variables full path and filenames

SourceFile = SourcePath
BUFile = BUPath
Debug.Print "SourceFile: " & SourceFile & " BUFile: " & BUFile

'Copies file to backup folder and renames it with the temp_ prefix.
Set aFilename = CreateObject("Scripting.FileSystemObject")
aFilename.CopyFile SourceFile, BUFile, True

'This section deletes the original file if it exists.

KillFile = SourceFile
'Check that file exists
If Len(Dir$(KillFile)) > 0 Then
    'First remove readonly attribute, if set
    SetAttr KillFile, vbNormal
    'Then delete the file
    fnWait (5)
    Kill KillFile
End If

'This section copies the temp_ file back to proper location, compacts it, and renames it back to the original filename.
DBEngine.CompactDatabase BUFile, SourceFile

End Function

Answer 1

执行压缩时，数据库引擎会创建一个新的空数据库并将对象复制到其中。如果在压缩操作期间发生错误，您最终可能会得到一个空数据库。您正在复制然后压缩回“实时”路径。

比较常见的做法是先压缩成一个临时文件，然后假设压缩成功，然后用临时文件替换主文件。