Veteran
Beiträge: 140
 
| wir haben das vor etlichen Jahren so gelöst :
Function Reorg3()
On Error GoTo Err_Reorg3
Dim VRet As Variant
Dim lpDBName As String
Dim lpDBName2 As String
Dim Verz As String
Dim AktuelleDB As Database
Dim Command As String
'Datei im aktuellen Programmpfad ?ffnen.
Open AktVerz & "DatenPfad.TXT" For Input As #1
Input #1, lpDBName
Close #1
If IsNull(lpDBName) = True Or lpDBName = "" Then
Exit Function
End If
Set AktuelleDB = DBEngine.Workspaces(0).OpenDatabase(lpDBName)
If AktuelleDB.Version = "12.0" Then
'DB ist schon aktuell 2010
MsgBox "Die DB wurde bereits in das Format 2010 konvertiert.", 64, "Konvertierung"
AktuelleDB.Close
Exit Function
End If
AktuelleDB.Close
Set AktuelleDB = DBEngine.Workspaces(0).Databases(0)
lpDBName2 = MID(lpDBName, 1, Len(lpDBName) - 3) & "SAVE12.0"
On Error GoTo Err_Reorg3
VRet = SysCmd(SYSCMD_INITMETER, "Umbenennen ", 100)
VRet = SysCmd(SYSCMD_UPDATEMETER, 10)
Name lpDBName As lpDBName2
VRet = SysCmd(SYSCMD_INITMETER, "Datenbank konvertieren ...", 100)
VRet = SysCmd(SYSCMD_UPDATEMETER, 20)
'funktioniert nicht (erzeugt veraltete Datenbank):
'Datenbank konvertieren alt, neu, , Version
'DBEngine.CompactDatabase lpDBName2, lpDBName, , dbVersion30
'DBEngine.CompactDatabase "E:\Archi_97.mdb", "E:\Archi_03", , dbVersion40
Command = "msaccess.exe """ & lpDBName2 & """ /convert """ & lpDBName & """"
VRet = Shell(Command, 1)
VRet = SysCmd(SYSCMD_INITMETER, "Fertig ", 100)
VRet = SysCmd(SYSCMD_UPDATEMETER, 100)
MsgBox "Die Konvertierung wurde durchgef?hrt.", 64, "Konvertierung"
Exit_Reorg3:
VRet = SysCmd(SYSCMD_REMOVEMETER)
Exit Function
Err_Reorg3:
MsgBox Error
Resume Exit_Reorg3
End Function
Viele Grüße
Stephan |
