web-dev-qa-db-fra.com

Comment compacter la base de données MS Access actuelle à partir de la fonction VBA

Je veux pouvoir exécuter le processus "compact et réparation" à partir d'un module VBA dans la base de données.

J'ai un processus par lots que j'exécute occasionnellement, il supprime quelques vieilles tables, les réimporte à partir d'autres bases de données, renomme quelques champs, fait quelques mises à jour et apporte quelques autres modifications mineures. Le processus n'est pas sorcier, mais il y a plusieurs étapes, il doit donc être automatisé.

Le problème est que quelques étapes (les MISES À JOUR) augmentent temporairement la taille de la base de données, ce qui peut entraîner des problèmes avec les importations ultérieures.

Si je fais le processus manuellement (y compris le compactage), alors tout fonctionne bien et je me retrouve avec une base de données de 800 Mo. Si j'utilise mon script VBA automatisé (sans compactage), il se bloque à mi-chemin lorsque la base de données dépasse la limite de 2 Go.

J'ai trouvé plusieurs sujets sur ce sujet, mais ils ont tous trois ou quatre ans (ou plus) et les méthodes qu'ils décrivent ne semblent plus fonctionner.

Existe-t-il des solutions qui fonctionnent avec Office 365 (version 1720)?

Le "compactage automatique" entraîne le compactage de la base de données à la fermeture, il ne permet PAS l'ajout du compactage de la base de données entre les étapes.

J'ai essayé ça:

Public Sub CompactDb2()
  Dim control As Office.CommandBarControl
  Set control = CommandBars.FindControl(Id:=2071)
 control.accDoDefaultAction
End Sub

Et ça:

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

Et ça....

Public Sub CompactDb3()
    Application.SetOption "Auto compact", True
End Sub

Parmi d'autres

ms-accessvba
3
ConanTheGerbil

Ce n'est tout simplement pas possible. Le compactage et la réparation d'une base de données nécessitent sa fermeture. En tant que tel, vous ne pouvez pas compacter et réparer une base de données entre les étapes d'un sous ou d'une procédure, car la base de données est ouverte lors de l'exécution de la procédure.

Vous remarquerez peut-être que le bouton Compacter et réparer sur le ruban nécessite un verrou exclusif, ferme la base de données, puis compacte et répare, puis la rouvre.

Mon conseil: exécutez le processus à partir d'une base de données externe, d'un fichier VBScript ou de PowerShell. Exécutez la première partie de votre lot, fermez le fichier, compactez et réparez, rouvrez, exécutez la deuxième partie

Exemple de code

Dim fileLocation As String
DBEngine.CompactDatabase fileLocation, fileLocation & "_1"
Kill fileLocation
Name fileLocation & "_1" As fileLocation

Vous pouvez également remarquer que le bouton Access compact et réparation fait quelque chose de similaire. Si vous exécutez Compact & Repair, il déplace les données vers une base de données appelée Database.accdb dans votre dossier actuel (le nom peut varier en fonction des noms existants/type de base de données), puis supprime votre base de données actuelle, puis renomme le nouveau.

Eh bien, mais rien n'est impossible, non?

Eh bien, certaines choses le sont, mais ce n'est pas l'une d'entre elles, si vous êtes prêt à faire des tromperies étranges. Comme je viens de le dire, le principal problème est que la base de données actuelle doit être fermée. Ainsi, la solution de contournement effectue les opérations suivantes:

  1. Créer par programme un fichier VBScript
  2. Ajoutez du code à ce fichier afin que nous puissions compacter et réparer notre base de données sans l'ouvrir
  3. Ouvrez et exécutez ce fichier de manière asynchrone
  4. Fermez notre base de données avant le compactage et la réparation
  5. Compacter et réparer la base de données (créer une copie), supprimer l'ancienne, renommer la copie
  6. Rouvrez notre base de données, continuez le batch
  7. Supprimer le fichier nouvellement créé

Heureusement, j'ai eu du temps à perdre, j'ai donc trouvé la solution suivante:

Public Sub CompactRepairViaExternalScript()
    Dim vbscrPath As String
    vbscrPath = CurrentProject.Path & "\CRHelper.vbs"
    If Dir(CurrentProject.Path & "\CRHelper.vbs") <> "" Then
        Kill CurrentProject.Path & "\CRHelper.vbs"
    End If
    Dim vbStr As String
    vbStr = "dbName = """ & CurrentProject.FullName & """" & vbCrLf & _
    "resumeFunction = ""ResumeBatch""" & vbCrLf & _
    "Set app = CreateObject(""Access.Application"")" & vbCrLf & _
    "Set dbe = app.DBEngine" & vbCrLf & _
    "Set objFSO = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf & _
    "On Error Resume Next" & vbCrLf & _
    "Do" & vbCrLf & _
    "If Err.Number <> 0 Then Err.Clear" & vbCrLf & _
    "WScript.Sleep 500" & vbCrLf & _
    "dbe.CompactDatabase dbName, dbName & ""_1""" & vbCrLf & _
    "errCount = errCount + 1" & vbCrLf & _
    "Loop While err.Number <> 0 And errCount < 100" & vbCrLf & _
    "If errCount < 100 Then" & vbCrLf & _
    "objFSO.DeleteFile dbName" & vbCrLf & _
    "objFSO.MoveFile dbName & ""_1"", dbName" & vbCrLf & _
    "app.OpenCurrentDatabase dbName" & vbCrLf & _
    "app.UserControl = True" & vbCrLf & _
    "app.Run resumeFunction" & vbCrLf & _
    "End If" & vbCrLf & _
    "objFSO.DeleteFile Wscript.ScriptFullName" & vbCrLf
    Dim fileHandle As Long
    fileHandle = FreeFile
    Open vbscrPath For Output As #fileHandle
    Print #fileHandle, vbStr
    Close #fileHandle
    Dim wsh As Object
    Set wsh = CreateObject("WScript.Shell")
    wsh.Run """" & vbscrPath & """"
    Set wsh = Nothing
    Application.Quit
End Sub

Cela effectue toutes les étapes décrites ci-dessus et reprend le lot en appelant la fonction ResumeBatch sur la base de données qui a appelé cette fonction (sans aucun paramètre). Notez que des choses comme la protection click-to-run et les antivirus/politiques n'aimant pas les fichiers vbscript peuvent ruiner cette approche.

4
Erik A

Voici le code VBA, j'ai essayé et travaillé, exécuté à partir d'Excel;

Sub CompactAndRepairAccessDB()

    Dim Acc As Object
    Set Acc = CreateObject("access.application")

    Dim dbPath As String, dbPathX As String
    dbPath = Application.ThisWorkbook.Path & "\" & "YourDatabaseNameHere.accdb"
    dbPathX = Application.ThisWorkbook.Path & "\" & "tmp.accdb"

    Acc.DBEngine.CompactDatabase dbPath, dbPathX
    Acc.Quit
    Set Acc = Nothing
    Kill dbPath
    Name dbPathX As dbPath

End Sub

Trouvé la solution dans ce lien et modifié un peu.

http://www.vbaexpress.com/forum/showthread.php?9262-Solved-VBA-Compact-and-Repair

0
Sacid Karacuha