Question

我有一个Access数据库，我需要将其反向工程到一个网站（app＆amp; data）。

我刚尝试使用Outlook 2013打开它，但是我收到一个错误，即数据库已启用复制，并且使用早期版本的Access创建了它（这会产生影响）。

我认为这只是复制问题。有没有办法删除复制，以便我可以在Access 2013中使用它？

Answer 1

因此，重新复制数据库并非易事。

首先，我找到了WV Mitchell的VBA脚本，它将您的表复制到一个新的数据库中： http://www.wvmitchell.com/tips/Removing%20Access%20Replication.htm

这不会复制主键或关系，所以我写了一些快速而肮脏的VBA脚本来帮助解决这个问题。

步骤1：在上面脚本的MakeOneTable函数中，我添加了这个（在db.Close行上面）：

Dim td As TableDef
Dim idxLoop As Index

Set td = db.TableDefs(TableName)
For Each idxLoop In td.Indexes
    If idxLoop.Primary = True Then

        Dim colnames As String
        colnames = idxLoop.Fields
        colnames = Replace(colnames, ";+", "],[")
        colnames = Replace(colnames, "+", "[")
        colnames = colnames & "]"
        Debug.Print "DoCmd.RunSQL ""CREATE INDEX [PrimaryKey] ON [" & TableName & "] (" & colnames & ") With Primary;"""

        Exit For
    End If
Next idxLoop

这将输出到Debug（立即）窗口的一些VBA代码，用于创建主键（以及创建新数据库并将数据导出到它--MM Mitchell的代码）。复制该VBA代码，将其放入新数据库中的模块/宏中，然后运行它 - 它应该创建主键。

步骤2：在旧（复制）数据库中，运行此VBA代码，这将生成更多用于创建关系的VBA代码：

Sub GenerateRelationshipCode()
    Dim db As DAO.Database
    Set db = CurrentDb()
    Dim rs As DAO.Recordset

    Set rs = db.OpenRecordset("SELECT DISTINCT szRelationship,szObject,szReferencedObject FROM MSysRelationships ORDER BY szObject,szReferencedObject")
    rs.MoveFirst

    Do While Not rs.EOF

        Dim rsFields As DAO.Recordset
        Set rsFields = db.OpenRecordset("SELECT * FROM MSysRelationships WHERE szRelationship = '" & Replace(rs.Fields(0), "'", "''") & "'")

        Dim PKFields As String, PKTable As String, FKFields As String, FKTable As String
        PKFields = "": PKTable = "": FKFields = "": FKTable = ""

        Do While Not rsFields.EOF
            PKFields = PKFields & rsFields("szReferencedColumn") & ","
            PKTable = rsFields("szReferencedObject")
            FKFields = FKFields & rsFields("szColumn") & ","
            FKTable = rsFields("szObject")
            rsFields.MoveNext
        Loop

        PKFields = Left(PKFields, Len(PKFields) - 1)
        FKFields = Left(FKFields, Len(FKFields) - 1)

        Debug.Print "Call AddRelationship(""" & rs.Fields(0) & """, """ & FKTable & """, """ & FKFields & """, """ & PKTable & """, """ & PKFields & """)"
        rs.MoveNext
    Loop

    Set db = Nothing
End Sub

您需要针对新数据库运行上面的输出，但您还需要此功能：

Public Sub AddRelationship(Name As String, FKTable As String, FKFields As String, PKTable As String, PKFields As String)
    Dim strSQL As String
    Dim db As DAO.Database
    Set db = CurrentDb()
    Name = "FK_" & Replace(FKTable, " ", "") & "_" & Replace(PKTable, " ", "") 'only enable this line if there aren't multiple relationships between same 2 tables
    strSQL = "ALTER TABLE [" & FKTable & "] " & _
    "  add constraint " & Name & " foreign key (" & FKFields & ") " & _
    "   references [" & PKTable & "](" & PKFields & ") "
    db.Execute strSQL, dbFailOnError
    Set db = Nothing
End Sub

在具有上述功能的模块中运行生成的VBA代码，它应该在新数据库中重建您的关系。

请注意，此代码快速而且脏，所以可能需要修复数据库/数据的错误。

取消复制Access数据库

1 个答案: