Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel compacter une base de donnée

compacter une base de donnée

2 réponses
Avatar
Xavier POWAGA
bonjour à tous,
j'ai développé un petit programme excel qui permet de gérer des données.
Pour éviter de perdre toute la saisie des données en cas d'oublie de
sauvegarde du fichier excel, et augmenter la rapidité des recherches par
des commandes SQL, mon programme excel pilote une base de donnée access
(.MDB).
Le problème c'est que, bien que le nombre d'enregistrement augmente peu dans
ma base, cette dernière a considérablement augmenter en taille (elle est
passé de 200ko à 20Mo). Je peux remédier à ce problème en passant par Access
et en compactant ma base. N' y aurait-il pas un autre moyen pour compacter
ma base directement avec mon programme excel sans passer par Acces.

Merci
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Michel Pierron
Bonsoir Xavier;
Affecte le nom de ta base (sans extension) à la constante dbName et modifie
ThisWorkbook.Path si ton fichier n'est pas dans le même répertoire que ta
base. A la copie du code, attention aux retours lignes parasites générés par
Outlook Express.

Option Explicit
' Ce fichier est à placer dans le même répertoire que la base; sinon,
' remplacer ThisWorkbook.Path par le chemin correct.
' Opérations réalisées:
' 1. Contrôle de l'espace disque suffisant pour ce faire
' 1. La base est zippée et sauvegardée dans le sous répertoire BD_Archives
' du répertoire auquel appartient ce fichier (le répertoire BD_Archives
' est automatiquement créé s'il est inexistant). 5 sauvegardes sont
' réalisées avant l'écrasement de la plus ancienne (de nom de la base_01.zip
' à nom de la base_05.zip).
' 2. Compacte la base originale sous nom de la base.bak
' 3. Sauvegarde la base originale sous nom de la base_old.mdb
' 4. Renomme la base compatée nom de la base.bak en nom de la base.mdb
' En cas de problème, 2 sauvegardes sont donc disponibles:
' Nom de la base_old.mdb et la plus récente nom de la base_xx.zip

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private AppName As String

Sub CompactBase()
'* Nom de la base (sans extension)
Const dbName As String = "Ici, le nom de ta base"
Dim dbPath As String: dbPath = ThisWorkbook.Path
AppName = Left$(ThisWorkbook.Name, InStr(1, ThisWorkbook.Name, ".") - 1)
If Dir(dbPath & "" & dbName & ".mdb") = "" Then
MsgBox "Impossible d'accéder au fichier:" & vbLf & dbName & ".mdb !", 64,
AppName
Exit Sub
End If
'* Si la base est en cours d'utilisation
If Len(Dir(dbPath & "" & dbName & ".ldb")) Then
MsgBox "Opération impossible actuellement," & vbLf & "Veuillez réessayer
ultérieurement !", 64, AppName
Exit Sub
End If
'* Contrôle de l'espace disponible suffisant
Dim Ko(1) As Long
Ko(0) = FreeSpaceOnDisk(dbPath): dbPath = dbPath & ""
Ko(1) = SizeFile(dbPath & dbName & ".mdb")
If Ko(0) - 3 * Ko(1) <= 0 Then
MsgBox "Opération impossible, espace disque insuffisant !", 48, AppName
Exit Sub
End If
If Dir("C:program fileswinzipWinzip32.exe") = "" Then
MsgBox "L'utilitaire Winzip n'est pas disponible sur votre machine !", 64,
AppName
Exit Sub
Else
If ZipSave(dbName) Then
Call ZipFile(dbPath & dbName & ".mdb", dbPath & "BD_Archives" & dbName &
"_1.zip")
End If
End If
'* Compacte dbName.mdb en dbName.bak
If DAO_CompactDatabase(dbPath & dbName & ".mdb", dbPath & dbName & ".bak")
Then
If Dir(dbPath & dbName & "_old.mdb") <> "" Then Kill dbPath & dbName &
"_old.mdb"
'* Renomme le fichier non compacté dbName.mdb en dbName_old.mdb
Name dbPath & dbName & ".mdb" As dbPath & dbName & "_old.mdb"
'* Renomme le fichier compacté dbName.bak en dbName.mdb
Name dbPath & dbName & ".bak" As dbPath & dbName & ".mdb"
End If
End Sub

Private Function ZipSave(sName As String) As Boolean
On Error GoTo 2
Dim PathEntry As String, sPath As String, i%, N As String * 1
sPath = ThisWorkbook.Path & "BD_Archives"
If Dir(sPath, vbDirectory) = "" Then MkDir sPath: GoTo 1
Dim Tablo(1 To 5) As String
PathEntry = Dir(sPath & "*.*", vbNormal + vbHidden)
While PathEntry <> ""
If PathEntry <> "." And PathEntry <> ".." Then
If InStr(1, PathEntry, sName, 1) And Right(PathEntry, 4) = ".zip" Then
If Len(sName) + 6 = Len(PathEntry) Then
N = Mid(PathEntry, Len(sName) + 2, 1)
Select Case Val(N)
Case 1 To 5: Tablo(Val(N)) = sPath & PathEntry
End Select
End If: End If: PathEntry = Dir(): End If
Wend
For i = UBound(Tablo) To LBound(Tablo) Step -1
If Len(Tablo(i)) Then
Select Case i
Case 5: Kill Tablo(i)
Case Else: Name Tablo(i) As sPath & sName & "_" & i + 1 & ".zip"
End Select
End If
Next i
1: ZipSave = True: Exit Function
2: ZipSave = False
End Function

Private Sub ZipFile(mdbFileName As String, zipFileName As String)
Const PathWinZip As String = "C:program fileswinzipWinzip32"
Dim strShell As String, WshShell, oExec
strShell = PathWinZip & " -min -a " & " " & Chr(34) & zipFileName _
& Chr(34) & " " & Chr(34) & mdbFileName & Chr(34)
Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec(strShell)
While oExec.Status = 0: Sleep 100: Wend
Set oExec = Nothing: Set WshShell = Nothing
End Sub

Private Function DAO_CompactDatabase(ByVal CompactFrom$, ByVal CompactTo$)
As Boolean
Application.Cursor = xlWait
If Len(Dir(CompactTo)) Then Kill CompactTo
Dim lErrDataBaseErrors As DAO.Error, lStrErrors As String
On Error Resume Next
DBEngine.CompactDatabase CompactFrom, CompactTo
If Err Then
For Each lErrDataBaseErrors In DBEngine.Errors
lStrErrors = lStrErrors & lErrDataBaseErrors.Number _
& vbLf & lErrDataBaseErrors.Description & vbLf
Next lErrDataBaseErrors
If Len(Dir(CompactTo)) Then Kill CompactTo
Application.Cursor = xlDefault
MsgBox "Erreurs:" & vbLf & lStrErrors, 64, AppName
Exit Function
End If
DAO_CompactDatabase = True: Application.Cursor = xlDefault
End Function

Private Function FreeSpaceOnDisk(drvPath As String) As Long
On Error GoTo 1
With CreateObject("Scripting.FileSystemObject")
FreeSpaceOnDisk = .GetDrive(.GetDriveName(drvPath)).FreeSpace / 1024
End With
Exit Function
1: MsgBox "Disque inexistant ou non disponible !", 48, AppName
End Function

Private Function SizeFile(FullPathName As String) As Long
On Error GoTo 1
With CreateObject("Scripting.FileSystemObject").GetFile(FullPathName)
SizeFile = .Size / 1024
End With
Exit Function
1: MsgBox "Fichier non trouvé !", 48, AppName
End Function

MP

"Xavier POWAGA" a écrit dans le message de news:
44f03079$0$4732$
bonjour à tous,
j'ai développé un petit programme excel qui permet de gérer des données.
Pour éviter de perdre toute la saisie des données en cas d'oublie de
sauvegarde du fichier excel, et augmenter la rapidité des recherches par
des commandes SQL, mon programme excel pilote une base de donnée access
(.MDB).
Le problème c'est que, bien que le nombre d'enregistrement augmente peu
dans ma base, cette dernière a considérablement augmenter en taille (elle
est passé de 200ko à 20Mo). Je peux remédier à ce problème en passant par
Access et en compactant ma base. N' y aurait-il pas un autre moyen pour
compacter ma base directement avec mon programme excel sans passer par
Acces.

Merci



Avatar
Michel Pierron
Re Xavier;
Bien evidemment, pour que ça marche (j'ai homis de le préciser), il faut
ajouter une référence à DAO (Microsoft DAO 3.6 Object Library) par exemple.

MP

"Xavier POWAGA" a écrit dans le message de news:
44f03079$0$4732$
bonjour à tous,
j'ai développé un petit programme excel qui permet de gérer des données.
Pour éviter de perdre toute la saisie des données en cas d'oublie de
sauvegarde du fichier excel, et augmenter la rapidité des recherches par
des commandes SQL, mon programme excel pilote une base de donnée access
(.MDB).
Le problème c'est que, bien que le nombre d'enregistrement augmente peu
dans ma base, cette dernière a considérablement augmenter en taille (elle
est passé de 200ko à 20Mo). Je peux remédier à ce problème en passant par
Access et en compactant ma base. N' y aurait-il pas un autre moyen pour
compacter ma base directement avec mon programme excel sans passer par
Acces.

Merci