Bout de code VBA pour compacter la base de donnée

Noel

unread,

Jan 7, 2003, 8:28:24 AM1/7/03

to

Bonjour et bonne année à tous et à toutes,

Je cherche le bout de code VBA pour compacter la base de donnée,

Merci

PS : ca va là Pierre (3stone) ;)
--
Noel

Jessy Sempere

unread,

Jan 7, 2003, 9:05:02 AM1/7/03

to

C'est mieux mais pas assez précis... ;-))))

C'est pour compacter la base en cours d'utilisation ???

@+
--------------------------------------------
Jessy Sempere
Délégation Infra INP-BC
Tél : 32.05.28 ou 01.40.48.05.28
jessy....@sncf.fr
--------------------------------------------
Noel <noel....@atlibitum.com> a écrit dans le message :
2fs297.o2a.ln@serveur...

Noel

unread,

Jan 7, 2003, 9:36:35 AM1/7/03

to

Oui, pour compacter la base en cours d'utilisation.

Noel

Jessy Sempere

unread,

Jan 7, 2003, 11:11:04 AM1/7/03

to

Voilà une solution pour compacter la base principal :

1°) Créer dans ta base une macro :
Nom de la macro : mcrCompact
Action : ExécuterCode
Argument de l'action : =Compact("mdb")
(si ta base et une base complément, remplacer mdb par mda)

2°) Créer dans ta base un module :
Nom du module : modCompactCurrentDb
Code du module :
****************************************************
Function CompactEXE() As Boolean

Dim strDbPath As String, strDbFile As String, _
strDbFileTmp As String

strDbPath = CurrentDb.Name
strDbFile = Dir(strDbPath)
strDbFileTmp = Left(strDbFile, Len(strDbFile) - 4) & "tmp.tmp"
strDbPath = Left(strDbPath, Len(strDbPath) - (Len(strDbFile) + 1))

With Application.FileSearch
.LookIn = strDbPath
.FileName = strDbFileTmp
.FileType = msoFileTypeAllFiles
If .execute = 1 Then Kill strDbPath & "\" & strDbFileTmp
End With

DBEngine.CreateDatabase strDbPath & "\" & strDbFileTmp, dbLangGeneral

DoCmd.CopyObject strDbPath & "\" & strDbFileTmp, _
, acMacro, "mcrCompact"
DoCmd.CopyObject strDbPath & "\" & strDbFileTmp, _
, acModule, "modCompactCurrentDb"

Shell "MSACCESS.EXE " & strDbPath & "\" & strDbFileTmp _
& " /x mcrCompact", vbMinimizedNoFocus

End Function

Public Function Compact(TypeBase As String)
Dim acApp As Access.Application
Dim strDbPath As String, strDbFile As String
Dim strDbFileOld As String

strDbPath = CurrentDb.Name
strDbFile = Left(strDbPath, Len(strDbPath) - 7) & "." & TypeBase
strDbFileOld = Left(strDbPath, Len(strDbPath) - 4) & ".old"
strDbPath = Left(strDbPath, Len(strDbPath) - (Len(Dir(strDbPath)) + 1))

Set acApp = GetObject(strDbFile)

With acApp
.SysCmd acSysCmdSetStatus, "Compactage en cours..."
.CloseCurrentDatabase
DBEngine.CompactDataBase strDbFile, strDbFileOld
Kill strDbFile
Name strDbFileOld As strDbFile
.OpenCurrentDatabase strDbFile
.SysCmd acSysCmdClearStatus
End With
Application.Quit
End Function
****************************************************

3°) Il n'y a plus qu'à lancer la fonction CompactExe()

phv211

unread,

Jan 8, 2003, 3:47:40 AM1/8/03

to

Bonjour Jessy

Petit problème d'utilisation de ton code avec par exemple un chemin du type
c:\Program Files\MaBaseRep\...
les espaces ne sont pas gérés dans ce code
je cherche

PHV

"Jessy Sempere" <jessy....@prg.sncf.fr> a écrit dans le message de news:
aveu63$rsd$1...@muguet.sncf.fr...

Jessy Sempere

unread,

Jan 8, 2003, 4:08:21 AM1/8/03

to

Effectivement, comme je ne mets jamais d'espace, je n'avais pas vu...

Donc il suffit juste de remplacer la ligne dans CompactEXE :

Shell "MSACCESS.EXE " & strDbPath & "\" & strDbFileTmp _
& " /x mcrCompact", vbMinimizedNoFocus

par :

Shell "MSACCESS.EXE """ & strDbPath & "\" & strDbFileTmp _
& """ /x mcrCompact", vbMinimizedNoFocus

@+

--------------------------------------------
Jessy Sempere
Délégation Infra INP-BC
Tél : 32.05.28 ou 01.40.48.05.28
jessy....@sncf.fr
--------------------------------------------

phv211 <phv...@caramail.com> a écrit dans le message :
umVBHIvtCHA.2028@TK2MSFTNGP11...

phv211

unread,

Jan 8, 2003, 4:26:43 AM1/8/03

to

Merci de la correction, ça fonctionne

PHV

"Jessy Sempere" <jessy....@prg.sncf.fr> a écrit dans le message de news:

avgppf$at5$1...@muguet.sncf.fr...