Программно обновить папку, полную файлов Access97, до Access2003 - PullRequest
2 голосов
/ 26 августа 2009

У меня есть папка, содержащая 100 с лишним файлов Access97. Мне нужно обновить их все до Access2003.

Я мог бы сделать это вручную, но использование VBA, вероятно, было бы намного быстрее.

Кто-нибудь, у кого был бы фрагмент, который сделал бы это? Или альтернативное предложение?

1 Ответ

3 голосов
/ 26 августа 2009

DBEngine.CompactDatabase olddb, newdb ,, dbVersion40 должно работать.

Обратите внимание, что вы захотите проверить свои ссылки после слов и сделать некоторую очистку. Я использовал следующий код в одной из моих систем, с которыми я работал в A97 и создавал MDB для A2000 и A2002. Идея заключалась в том, что преобразование добавило несколько ссылок, от которых я хотел избавиться программно, поэтому мне никогда не приходилось беспокоиться о них. Вы, вероятно, захотите записать вывод в файл .txt, названный так же, как MDB, и проверить все по ходу дела.

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...