以编程方式将Access 97文件的完整文件夹更新到Access 2003

时间:2009-08-26 00:39:20

标签: ms-access vba

我有一个装满100多个Access97文件的文件夹。我需要将它们全部更新到Access2003。

我可以手动完成,但使用VBA可能要快得多。

有没有人会有这样做的代码片段?或另一种建议?

1 个答案:

答案 0 :(得分:3)

DBEngine.CompactDatabase olddb,newdb ,, dbVersion40 应该工作。

请注意,您需要在单词后检查您的引用并进行一些清理。我在A97中使用的系统中使用了以下代码,并制作了A2000和A2002 MDB。我的想法是转换添加了一些我想要以编程方式摆脱的引用,所以我从来不必担心它们。您可能希望将输出记录到名为与MDB相同的.txt文件中,并在进行检查时进行检查。

Function tt_FixReferences() As Boolean

Dim ref As Reference
Dim stMsg As String, intPosn As Integer, strRefPathName As String, blnCompile As Boolean


    On Error GoTo tagError
    For Each ref In Access.References
        If ref.IsBroken Then
             VBA.MsgBox "Ref" & ref.name & " is broken."
        Else
 '           Debug.Print ref.Name & ", " & ref.FullPath
            Select Case Access.SysCmd(acSysCmdAccessVer)
            Case 9#  ' Access 2000
                If ref.name = "VBIDE" Then
                    strRefPathName = ref.FullPath
                    References.Remove ref
                    VBA.MsgBox strRefPathName & " removed."
                    blnCompile = True
                End If
            Case 10# ' Access 2002
                If ref.name = "VBIDE" Or ref.name = "OWC10" Then
                    strRefPathName = ref.FullPath
                    References.Remove ref
                    VBA.MsgBox strRefPathName & " removed."
                    blnCompile = True
                End If
            End Select
        End If
    Next ref
    tt_FixReferences = True
    If blnCompile = True Then
        Call Access.SysCmd(504, 16483)
        MsgBox "Compiled."
    End If


tagExit:
    Exit Function

tagError:
    If err = 48 Then ' ?????
        If VBA.Len(VBA.Dir(ref.FullPath)) > 0 Then
            References.AddFromGuid ref.Guid, ref.Major, ref.Minor
            Resume Next
        Else
            stMsg = "Reference " & vbCrLf & "'" & ref.FullPath & "'" _
                    & vbCrLf & "couldn't be restored."
            VBA.MsgBox stMsg, vbCritical + vbOKOnly, _
                    "Error restoring references."
            tt_FixReferences = False
            Resume tagExit
        End If
    Else
        stMsg = "An unexpected error occurred." _
            & vbCrLf & "Number: " & err.Number _
            & vbCrLf & "Description: " & err.Description
        VBA.MsgBox stMsg, vbCritical + vbOKOnly, _
            "Error restoring references."
        tt_FixReferences = False
        Resume tagExit
    End If
End Function