MS Access: wie aktuelle Datenbank in VBA

Question

compact Ziemlich einfache Frage, ich weiß.

Answer 1

Wenn Sie komprimieren möchten/reparieren eine externe MDB-Datei (nicht die, die Sie in gerade arbeiten):

Application.compactRepair sourecFile, destinationFile 

Wenn Sie die Datenbank komprimieren Sie arbeiten mit:

Application.SetOption "Auto compact", True 

In diesem letzten Fall wird Ihre App beim Schließen der Datei komprimiert.

Meine Meinung: das Schreiben ein paar Zeilen Code in einer zusätzlichen MDB "compacter" -Datei, die Sie aufrufen können, wenn Sie eine MDB-Datei komprimieren/reparieren wollen, ist sehr nützlich: in den meisten Situationen kann die Datei nicht kompaktiert werden normal geöffnet werden, so dass Sie die Methode von außerhalb der Datei aufrufen müssen.

Andernfalls sollte der Autocompact standardmäßig in jedem Hauptmodul einer Access App auf true gesetzt werden.

Im Falle einer Katastrophe, erstellen Sie eine neue MDB-Datei und importieren Sie alle Objekte aus der fehlerhaften Datei. In der Regel finden Sie ein fehlerhaftes Objekt (Formular, Modul usw.), das Sie nicht importieren können.

Answer 2

Überprüfen Sie diese Lösung VBA Compact Current Database.

Im Grunde sagt, dass es diese

Public Sub CompactDB() 
    CommandBars("Menu Bar").Controls("Tools").Controls ("Database utilities"). _ 
    Controls("Compact and repair database...").accDoDefaultAction 
End Sub 

Answer 3

Ja, es einfach funktionieren soll, ist zu tun.

Im Grunde findet es nur das Menüelement "Compact and repair" und klickt es programmatisch.

Answer 4

Ich habe das viele Jahre zurück 2003 oder möglicherweise 97, yikes!

Wenn ich mich erinnere, müssen Sie einen der oben genannten Unterbefehle an einen Timer gebunden verwenden. Sie können auf der Datenbank nicht mit Verbindungen oder offenen Formularen arbeiten.

Sie tun also etwas über das Schließen aller Formulare, und starten Sie den Timer als die letzte laufende Methode. (das wird wiederum die kompakte Operation nennen, sobald alles schließt)

Wenn Sie dies nicht herausgefunden haben, könnte ich durch meine Archive graben und ziehen Sie es hoch.

Answer 5

Wenn der Benutzer den FE beendet, versuchen Sie, die Backend-MDB vorzugsweise mit dem heutigen Datum im Namen im JJJJ-MM-TT-Format umzubenennen. Stellen Sie sicher, dass Sie alle gebundenen Formulare einschließlich ausgeblendeter Formulare und Berichte schließen, bevor Sie dies tun. Wenn Sie eine Fehlermeldung erhalten, oops, ist es beschäftigt, also nicht stören. Wenn es erfolgreich ist, dann komprimiere es zurück.

Siehe meine Backup, do you trust the users or sysadmins? Tipps Seite für weitere Informationen.

Answer 6

Es gibt auch Michael Kaplans SOON ("Shut One, Open New") add-in. Sie müssten es verketten, aber es ist eine Möglichkeit, dies zu tun.

Ich kann nicht sagen, dass ich viel Grund gehabt habe, das jemals programmatisch zu machen, da ich für Endanwender programmiere, und sie nie irgendetwas außer dem Frontend in der Zugangsbenutzerschnittstelle benutzen, und dort ist kein Grund, ein richtig gestaltetes Frontend regelmäßig zu verdichten.

Answer 7

DBEngine.CompactDatabase Quelle, dest

Answer 8

Wenn Sie die Datenbank mit einem vorderen Ende und einem hinteren Ende haben. Sie können den folgenden Code auf der Hauptform des vorderen Ende Hauptnavigation Formular:

Dim sDataFile As String, sDataFileTemp As String, sDataFileBackup As String 
Dim s1 As Long, s2 As Long 

sDataFile = "C:\MyDataFile.mdb" 
sDataFileTemp = "C:\MyDataFileTemp.mdb" 
sDataFileBackup = "C:\MyDataFile Backup " & Format(Now, "YYYY-MM-DD HHMMSS") & ".mdb" 

DoCmd.Hourglass True 

'get file size before compact 
Open sDataFile For Binary As #1 
s1 = LOF(1) 
Close #1 

'backup data file 
FileCopy sDataFile, sDataFileBackup 

'only proceed if data file exists 
If Dir(sDataFileBackup vbNormal) <> "" Then 

     'compact data file to temp file 
     On Error Resume Next 
     Kill sDataFileTemp 
     On Error GoTo 0 
     DBEngine.CompactDatabase sDataFile, sDataFileTemp 

     If Dir(sDataFileTemp, vbNormal) <> "" Then 
      'delete old data file data file 
      Kill sDataFile 

      'copy temp file to data file 
      FileCopy sDataFileTemp, sDataFile 

      'get file size after compact 
      Open sDataFile For Binary As #1 
      s2 = LOF(1) 
      Close #1 

      DoCmd.Hourglass False 
      MsgBox "Compact complete " & vbCrLf & vbCrLf _ 
       & "Size before: " & Round(s1/1024/1024, 2) & "Mb" & vbCrLf _ 
       & "Size after: " & Round(s2/1024/1024, 2) & "Mb", vbInformation 
     Else 
      DoCmd.Hourglass False 
      MsgBox "ERROR: Unable to compact data file" 
     End If 

Else 
     DoCmd.Hourglass False 
     MsgBox "ERROR: Unable to backup data file" 
End If 

DoCmd.Hourglass False 

Answer 9

Try dieses Modul hinzufügen, ziemlich einfach, nur startet Access öffnet die Datenbank, um die „Compact auf Close“ Option legt "True", dann beendet.

Syntax zu auto-compact:

acCompactRepair "C:\Folder\Database.accdb", True 

zurückzukehren * auf Standard:

acCompactRepair "C:\Folder\Database.accdb", False 

* nicht notwendig, aber wenn Ihre Back-End-Datenbank> 1GB dies ziemlich ärgerlich sein kann, wenn Sie gehen Sie direkt hinein und es dauert 2 Minuten um aufzuhören!

EDIT: Option hinzugefügt, um durch alle Ordner recurse, ich führe diese Nacht, um Datenbanken auf ein Minimum zu halten.

'accCompactRepair 
'v2.02 2013-11-28 17:25 

'=========================================================================== 
' HELP CONTACT 
'=========================================================================== 
' Code is provided without warranty and can be stolen and amended as required. 
' Tom Parish 
' TJP@tomparish.me.uk 
' http://baldywrittencod.blogspot.com/2013/10/vba-modules-access-compact-repair.html 
' DGF Help Contact: see BPMHelpContact module 
'========================================================================= 

'includes code from 
'http://www.ammara.com/access_image_faq/recursive_folder_search.html 
'tweaked slightly for improved error handling 

' v2.02 bugfix preventing Compact when bAutoCompact set to False 
'   bugfix with "OLE waiting for another application" msgbox 
'   added "MB" to start & end sizes of message box at end 
' v2.01 added size reduction to message box 
' v2.00 added recurse 
' v1.00 original version 

Option Explicit 

Function accSweepForDatabases(ByVal strFolder As String, Optional ByVal bIncludeSubfolders As Boolean = True _ 
    , Optional bAutoCompact As Boolean = False) As String 
'v2.02 2013-11-28 17:25 
'sweeps path for .accdb and .mdb files, compacts and repairs all that it finds 
'NB: leaves AutoCompact on Close as False unless specified, then leaves as True 

'syntax: 
' accSweepForDatabases "path", [False], [True] 

'code for ActiveX CommandButton on sheet module named "admin" with two named ranges "vPath" and "vRecurse": 
' accSweepForDatabases admin.Range("vPath"), admin.Range("vRecurse") [, admin.Range("vLeaveAutoCompact")] 

Application.DisplayAlerts = False 

Dim colFiles As New Collection, vFile As Variant, i As Integer, j As Integer, sFails As String, t As Single 
Dim SizeBefore As Long, SizeAfter As Long 
t = Timer 
RecursiveDir colFiles, strFolder, "*.accdb", True 'comment this out if you only have Access 2003 installed 
RecursiveDir colFiles, strFolder, "*.mdb", True 

    For Each vFile In colFiles 
     'Debug.Print vFile 
     SizeBefore = SizeBefore + (FileLen(vFile)/1048576) 
On Error GoTo CompactFailed 
    If InStr(vFile, "Geographical Configuration.accdb") > 0 Then MsgBox "yes" 
     acCompactRepair vFile, bAutoCompact 
     i = i + 1 'counts successes 
     GoTo NextCompact 
CompactFailed: 
On Error GoTo 0 
     j = j + 1 'counts failures 
     sFails = sFails & vFile & vbLf 'records failure 
NextCompact: 
On Error GoTo 0 
     SizeAfter = SizeAfter + (FileLen(vFile)/1048576) 

    Next vFile 

Application.DisplayAlerts = True 

'display message box, mark end of process 
    accSweepForDatabases = i & " databases compacted successfully, taking " & CInt(Timer - t) & " seconds, and reducing storage overheads by " & Int(SizeBefore - SizeAfter) & "MB" & vbLf & vbLf & "Size Before: " & Int(SizeBefore) & "MB" & vbLf & "Size After: " & Int(SizeAfter) & "MB" 
    If j > 0 Then accSweepForDatabases = accSweepForDatabases & vbLf & j & " failures:" & vbLf & vbLf & sFails 
    MsgBox accSweepForDatabases, vbInformation, "accSweepForDatabases" 

End Function 

Function acCompactRepair(ByVal pthfn As String, Optional doEnable As Boolean = True) As Boolean 
'v2.02 2013-11-28 16:22 
'if doEnable = True will compact and repair pthfn 
'if doEnable = False will then disable auto compact on pthfn 

On Error GoTo CompactFailed 

Dim A As Object 
Set A = CreateObject("Access.Application") 
With A 
    .OpenCurrentDatabase pthfn 
    .SetOption "Auto compact", True 
    .CloseCurrentDatabase 
    If doEnable = False Then 
     .OpenCurrentDatabase pthfn 
     .SetOption "Auto compact", doEnable 
    End If 
    .Quit 
End With 
Set A = Nothing 
acCompactRepair = True 
Exit Function 
CompactFailed: 
End Function 


'source: http://www.ammara.com/access_image_faq/recursive_folder_search.html 
'tweaked slightly for error handling 

Private Function RecursiveDir(colFiles As Collection, _ 
          strFolder As String, _ 
          strFileSpec As String, _ 
          bIncludeSubfolders As Boolean) 

    Dim strTemp As String 
    Dim colFolders As New Collection 
    Dim vFolderName As Variant 

    'Add files in strFolder matching strFileSpec to colFiles 
    strFolder = TrailingSlash(strFolder) 
On Error Resume Next 
    strTemp = "" 
    strTemp = Dir(strFolder & strFileSpec) 
On Error GoTo 0 
    Do While strTemp <> vbNullString 
     colFiles.Add strFolder & strTemp 
     strTemp = Dir 
    Loop 

    If bIncludeSubfolders Then 
     'Fill colFolders with list of subdirectories of strFolder 
On Error Resume Next 
     strTemp = "" 
     strTemp = Dir(strFolder, vbDirectory) 
On Error GoTo 0 
     Do While strTemp <> vbNullString 
      If (strTemp <> ".") And (strTemp <> "..") Then 
       If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then 
        colFolders.Add strTemp 
       End If 
      End If 
      strTemp = Dir 
     Loop 

     'Call RecursiveDir for each subfolder in colFolders 
     For Each vFolderName In colFolders 
      Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True) 
     Next vFolderName 
    End If 

End Function 

Private Function TrailingSlash(strFolder As String) As String 
    If Len(strFolder) > 0 Then 
     If Right(strFolder, 1) = "\" Then 
      TrailingSlash = strFolder 
     Else 
      TrailingSlash = strFolder & "\" 
     End If 
    End If 
End Function 

Answer 10

Application.SetOption "Auto compact", False ‚(siehe oben) Verwenden Sie diese mit einem Knopf Bildunterschrift: "DB nicht Compact On Close"

Code über die Beschriftung mit„DB Compact hin- und herzuschalten On Close " zusammen mit Application.SetOption" Auto compact ", True

AutoCompact kann über die Schaltfläche oder per Code eingestellt werden, zB nach dem Import von großen Temp-Tabellen.

Das Startformular kann Code haben, der Auto Compact deaktiviert, so dass es nicht jedes Mal ausgeführt wird.

Auf diese Weise versuchen Sie nicht, Access zu bekämpfen.

Answer 11

Wenn Sie beim Schließen keine Komprimierung verwenden möchten (z. B. weil die Front-End-MDB ein ständig laufendes Roboterprogramm ist), und Sie keine separate MDB nur zum Komprimieren erstellen möchten, sollten Sie sie verwenden eine cmd-Datei.

Ich lasse meinen robot.mdb seine eigene Größe überprüfen:

FileLen(CurrentDb.Name)) 

Wenn seine Größe 1 GB überschreitet, erstellt es eine cmd-Datei wie folgt ...

Dim f As Integer 
Dim Folder As String 
Dim Access As String 
    'select Access in the correct PF directory (my robot.mdb runs in 32-bit MSAccess, on 32-bit and 64-bit machines) 
    If Dir("C:\Program Files (x86)\Microsoft Office\Office\MSACCESS.EXE") > "" Then 
     Access = """C:\Program Files (x86)\Microsoft Office\Office\MSACCESS.EXE""" 
    Else 
     Access = """C:\Program Files\Microsoft Office\Office\MSACCESS.EXE""" 
    End If 
    Folder = ExtractFileDir(CurrentDb.Name) 
    f = FreeFile 
    Open Folder & "comrep.cmd" For Output As f 
    'wait until robot.mdb closes (ldb file is gone), then compact robot.mdb 
    Print #f, ":checkldb1" 
    Print #f, "if exist " & Folder & "robot.ldb goto checkldb1" 
    Print #f, Access & " " & Folder & "robot.mdb /compact" 
    'wait until the robot mdb closes, then start it 
    Print #f, ":checkldb2" 
    Print #f, "if exist " & Folder & "robot.ldb goto checkldb2" 
    Print #f, Access & " " & Folder & "robot.mdb" 
    Close f 

... Einführungen die cmd-Datei ...

Shell ExtractFileDir(CurrentDb.Name) & "comrep.cmd" 

... und schaltet ...

DoCmd.Quit 

Als nächstes komprimiert und startet die cmd-Datei robot.mdb.

Answer 12

Versuchen Sie dies. Es funktioniert in derselben Datenbank, in der sich der Code befindet. Rufen Sie einfach die unten gezeigte CompactDB() -Funktion auf. Stellen Sie sicher, dass Sie nach dem Hinzufügen der Funktion auf die Schaltfläche Speichern im VBA-Editor-Fenster klicken, bevor Sie sie zum ersten Mal ausführen. Ich habe es nur in Access 2010 getestet. Ba-da-bing, ba-da-boom.

Public Function CompactDB() 

    Dim strWindowTitle As String 

    On Error GoTo err_Handler 

    strWindowTitle = Application.Name & " - " & Left(Application.CurrentProject.Name, Len(Application.CurrentProject.Name) - 4) 
    strTempDir = Environ("Temp") 
    strScriptPath = strTempDir & "\compact.vbs" 
    strCmd = "wscript " & """" & strScriptPath & """" 

    Open strScriptPath For Output As #1 
    Print #1, "Set WshShell = WScript.CreateObject(""WScript.Shell"")" 
    Print #1, "WScript.Sleep 1000" 
    Print #1, "WshShell.AppActivate " & """" & strWindowTitle & """" 
    Print #1, "WScript.Sleep 500" 
    Print #1, "WshShell.SendKeys ""%yc""" 
    Close #1 

    Shell strCmd, vbHide 
    Exit Function 

    err_Handler: 
    MsgBox "Error " & Err.Number & ": " & Err.Description 
    Close #1 

End Function