Non fermeture d'une base Access

Bonjour et merci de votre aide,

Mon problème : dans une première base de donnée, j'ai une procédure COMPACTER
qui lance une seconde base COMPACTAGE.MDB

La procédure COMPACTER est appelée lorsqu'on quitte la première base.

Voici le code :

Sub Compacter()
On Error GoTo Traitement_Err

Dim db As Database
Dim StAppName As String
Set db = CurrentDb
'Passe aussi le chemin de la base de compactage
StAppName = "MSACCESS.EXE " & Chr(34) & CheminBase(db.Name) & " " & Chr(34) &
"/CMD " & db.Name

Call Shell(StAppName, 6)

Set db = Nothing

DoCmd.Quit


Exit_Traitement_Err:
Exit Sub

Traitement_Err:
Select Case Err
Case Else
MsgBox "Procédure compacter" & Chr$(13) & "Erreur n° " & Err &
Chr$(13) & Err.Description
End Select
Resume Exit_Traitement_Err

End Sub

Function CheminBase(NomBase As String)
On Error GoTo Traitement_Err

Dim Pos As Integer
Dim i As Integer

Pos = 0
For i = 1 To Len(NomBase)
If Mid(NomBase, i, 1) = "\" Then Pos = i
Next
CheminBase = Left(NomBase, Pos) & "Compactage V4.mde"

Exit_Traitement_Err:
Exit Function

Traitement_Err:
Select Case Err
Case Else
MsgBox "Fonction CheminBase" & Chr$(13) & "Erreur n° " & Err &
Chr$(13) & Err.Description
End Select
Resume Exit_Traitement_Err

End Function



Voici le code lorsqu'on quitte l'application :

' Quitte l'application.
Case conCmdQuitterApplication
Compacter
CloseCurrentDatabase




Dans la seconde base COMPACTAGE.MDB, voici le code à l'ouverture du formulaire
chargé par défaut ; ce code lance le compactage de la première base de données
:

Private Sub Form_Load()
On Error GoTo Err_
' 2 Minutes d'attente maxi si problème
Const Temps_max As Integer = 2
Dim Base As String
Dim New_Base As String
Dim Old_Base As String
Dim T0 As Date
Dim T As Date
Dim Msg As String
Dim Memo_err As Integer
Dim TailleFichier As Long
Const Rapport As String = "C:\Compactage.log"

' Renvoie la longueur du fichier c:\compactage.log (en octets).
If Dir(Rapport) <> "" Then
TailleFichier = FileLen(Rapport)
' Efface le fichier si trop long
If TailleFichier > 5000 Then
Open Rapport For Output As #1
Else
Open Rapport For Append As #1
End If
Else
Open Rapport For Append As #1
End If

Base = Command()
T0 = Now

New_Base = Left(Command, Len(Command()) - 3) & "new"
Old_Base = Left(Command, Len(Command()) - 3) & "old"


Print #1, "Compactage de la base " & Base
Print #1, "Début à " & T0

If Dir(New_Base) <> "" Then
Kill New_Base
Print #1, Now & " : " & "La base " & New_Base & " a été effacée."
End If

DBEngine.CompactDatabase Base, New_Base
Print #1, Now & " : " & "Compactage de la base " & New_Base

If Dir(Old_Base) <> "" Then
Kill Old_Base
Print #1, Now & " : " & "La base " & Old_Base & " a été effacée."
End If

Name Base As Old_Base
Print #1, Now & " : " & "La base " & Base & " a été renommée en " & Old_Base
Name New_Base As Base
Print #1, Now & " : " & "La base " & New_Base & " a été renommée en " & Base


'Base = "MSACCESS.EXE " & Chr$(34) & Base & " " & Chr(34)
'Call Shell(Base, vbMaximizedFocus)
'Print #1, Now & " : " & "La base " & Base & " a été rélancée."
Print #1, Now & " : " & "Fin du Compactage"
Close #1
DoCmd.Quit

Exit_err:
Exit Sub

Err_:
' On sort du programme après x minutes d'attente suite à une erreur
T = Now
If (T - T0) * (24 * 60) > Temps_max Then
Msg = Now & " : " & "Impossible de compacter la base " & Base & " depuis "
& Temps_max & " minutes." & vbCr _
& "La base " & Base & " doit être compactée manuellement et relancée." &
vbCr & "Fin du programme à " & T
Print #1, Msg
Close #1
MsgBox (Msg)
DoCmd.Quit
End If

Select Case Err
Case 3356: 'Base à compacter non fermée
If Memo_err <> Err Then Print #1, T & " : la base " & Base & " est en
cours d'utilisation..."
Case Else
If Memo_err <> Err Then Print #1, T & " : " & Err & vbCr &
Err.Description
End Select

Memo_err = Err
Resume

End Sub


PROBLEME : la base COMPACTAGE.MDB ne se ferme pas toujours selon le PC où le
programme est installé : sur certains PC, elle reste ouverte sous forme d'icône
; dans ce cas, on peut avoir de nombreuses icones de ce programme ouvert d'où
saturation de la mémoire.

Sur d'autres PC, la base se ferme sans problème.

Pourquoi la base ne se ferme t-elle pas toujours ? Comment faire pour qu'elle
se ferme toujours ?

Y a t-il un paramétrage particulier de Windows qui fait que le programme reste
ouvert ?