[AC-2016] Problême pour fermer une base de données Access par VBA Excel

Problême pour fermer une base de données Access par VBA Excel

Bonjour,

Par un code Excel je pilote une session Access pour générer des requètes pour traitement in fine dans Excel.
En cours de code, je cherche à libérer mon fichier base de données pour ensuite effectuer un compactage de la DB.
Pour ce faire j'utilise la méthode :

AccessApp.CloseCurrentDatabase (où AccessApp est ma variable objet Access)

Visuellement, je vois bien que la DB a été fermée dans Access, cependant le fichier lock avec extension laccdb reste ouvert ce qui m'empêche d'initier ma commande de compactage.
C'est une fois mon code entièrement exécuté que le fichier lock se supprime.

Curieusement, quand j'ouvre une base de données vide et que je la ferme de suite avec la méthode : AccessApp.CloseCurrentDatabase
Le fichier lock se supprime sans problèmes immédiatement. Ce problème ne semble donc survenir qu'avec ma base de données de travail.

Je n'arrive donc pas à comprendre pourquoi le fichier .laccdb reste ouvert à l'issue de la commande de fermeture.
Je vous remercie par avance pour votre aide.

Bonjour,
ta base de données est bien fermée mais pas Access!

Code:

AccessApp.quit

pour le compactage!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub Test()
CompactDb "C:\RepAccess\FichierAccess.accdb"
End Sub
Sub CompactDb(Db As String)
  Dim fso,  DBEngine
Set fso = CreateObject("Scripting.FileSystemObject")
 
Dim DbAs As String
DbAs = Replace(Db, "." & Split(Db, ".")(UBound(Split(Db, "."))), "_As." & Split(Db, ".")(UBound(Split(Db, "."))))
If fso.FileExists(DbAs) = True Then
    fso.DeleteFile DbAs
End If
Set DBEngine = CreateObject("DAO.DBEngine.120")
DBEngine.CompactDatabase Db, DbAs
MySeconde 1
 fso.DeleteFile Db
 fso.CopyFile DbAs, Db
End Sub
Sub MySeconde(Inter As Integer)
 Dim s As Integer
Dim sSave As Integer
Dim Sm As Integer
s = Second(Time)
 
If Sm = 0 Then Sm = s: sSave = Inter
While Inter <> 0
    If s <> sSave Then Inter = Val(Inter) - 1
    sSave = s
    s = Second(Time)
    DoEvents
Wend
 End Sub

Bonjour rdurupt et merci pour ta réponse.

J'avais également essayé avec AccessApp.Quit ou AccessApp.Docmd.Quit avec le même résultat le fichier lock est toujours présent.
Ce n'est que la fin du code ou l'arrêt manuel du débug qui libère ce fichier.
Pour le compactage, j'utilise la commande AccessApp.CompactRepair qui fonctionne parfaitement à condition que le fichier DB soit libéré.

Si dessous mon code :
Les commandes de compactage en fin de procédures sont en commentaires car Excel m'informe que la base de données n'est pas accessible pour les raisons mentionnées ci-dessus.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
Sub VisitesGlobalesFileSetup(vPathDataTCD As String)
 
    ' ----------------------------------------------------
    ' ----- Préparation des data pour TCD via Access -----
    ' ----------------------------------------------------
 
    Dim AccessApp                           As Access.Application
    Dim wbTCDDataVisites                    As Workbook
    Dim vSql                                As String
    Dim vQuerySave                          As Variant
    Dim vLimitDate                          As String
 
    Const cTemplateImport                   As String = "TemplateImportHistoVisites"
    Const cTableName                        As String = "VisitesGlobales"
    Const cPathAccess                       As String = "\Documents\Travail\DTN\Statistiques\CPSI_NC_Conso Matière\Templates\DataSetup.accdb"
    Const cPathAccessRepaired               As String = "\Documents\Travail\DTN\Statistiques\CPSI_NC_Conso Matière\Templates\DataSetupRepaired.accdb"
    Const cPathAccessLockedFile             As String = "\Documents\Travail\DTN\Statistiques\CPSI_NC_Conso Matière\Templates\DataSetup.laccdb"
    Const cErrorTable                       As String = "Visites Globales"
    Const cErrorMessage                     As String = "Erreurs d'importation"
    Const cReqVisitesGlobales               As String = "Requete Visites Globales"
    Const cReqVisitesS                      As String = "Requete_Visites S"
    Const cReqVisitesI                      As String = "Requete Visites I"
    Const cDataTCDNameFile                  As String = "Data TCD Visites"
 
    ' ----------------------------------------------------
    ' ----- Préparation du fichier Excel de data TCD -----
    ' ----------------------------------------------------
    Set wbTCDDataVisites = Workbooks.Add
    With wbTCDDataVisites
        .SaveAs Environ("Userprofile") & cPathViewer & vAnnee & "\" & vIdMois & _
            "_" & vMois & "\" & cPathSourceFiles & cDataTCDNameFile & "_" & vAnnee & "_" & vIdMois & ".xlsx", _
            FileFormat:=xlOpenXMLWorkbook
        vPathDataTCD = .Path & "\" & .Name
        .Close
    End With
 
    Set AccessApp = New Access.Application
 
    vPathFile = Environ("Userprofile") & cPathViewer & vAnnee & "\" & vIdMois & "_" & vMois & "\" & cPathSourceFiles
 
    AccessApp.OpenCurrentDatabase Environ("Userprofile") & cPathAccess
    AccessApp.DoCmd.TransferText acImportDelim, cTemplateImport, cTableName, vPathFile & cVisitesGlobales & "_" & vAnnee & "_" & vIdMois & ".txt"
    AccessApp.DoCmd.DeleteObject acTable, cErrorTable & "_" & vAnnee & "_" & vIdMois & "_" & cErrorMessage
 
    vLimitDate = DateSerial(vAnnee, CInt(vIdMois) + 1, 0)
 
 
    ' --------------------------
    ' ----- Data Cleansing -----
    ' --------------------------
 
    ' Formatage de la date de fin de période en inversant jour et mois
    vLimitDate = "#" & CInt(vIdMois) & "/" & Format(DateSerial(vAnnee, CInt(vIdMois) + 1, 0), "d") & "/" & vAnnee & "#"
 
    vSql = "DELETE VisitesGlobales.TypeVisite "
    vSql = vSql & "FROM VisitesGlobales "
    vSql = vSql & "WHERE VisitesGlobales.TypeVisite Is Null "
    vSql = vSql & "Or VisitesGlobales.TypeVisite Like ""Visite"";"
    AccessApp.CurrentDb.Execute vSql
 
    vSql = "DELETE VisitesGlobales.Statut "
    vSql = vSql & "FROM VisitesGlobales "
    vSql = vSql & "WHERE VisitesGlobales.Statut Like ""LO"";"
    AccessApp.CurrentDb.Execute vSql
 
    vSql = "DELETE VisitesGlobales.DateExec "
    vSql = vSql & "FROM VisitesGlobales "
    vSql = vSql & "WHERE VisitesGlobales.DateExec>" & vLimitDate & ";"
    AccessApp.CurrentDb.Execute vSql
 
    vSql = "DELETE VisitesGlobales.Ptrv "
    vSql = vSql & "FROM VisitesGlobales "
    vSql = vSql & "WHERE (VisitesGlobales.Ptrv Like ""2100*"") Or (VisitesGlobales.Ptrv Like ""2142*"");"
    AccessApp.CurrentDb.Execute vSql
 
 
    ' --------------------------------------------
    ' ----- Génération des requêtes data TCD -----
    ' --------------------------------------------
 
    vSql = "ALTER TABLE [VisitesGlobales] ADD COLUMN CN_Plan number"
    AccessApp.CurrentDb.Execute vSql
    vSql = "ALTER TABLE [VisitesGlobales] ADD COLUMN CN_Real number"
    AccessApp.CurrentDb.Execute vSql
 
    vSql = "UPDATE VisitesGlobales SET VisitesGlobales.CN_Plan = 1;"
    AccessApp.CurrentDb.Execute vSql
 
    vSql = "UPDATE VisitesGlobales SET VisitesGlobales.CN_Real = IIf([VisitesGlobales]![Statut]=""CO"",1,0);"
    AccessApp.CurrentDb.Execute vSql
 
    ' Requête Visites Globales
    vSql = "SELECT VisitesGlobales.Ptrv, Sum(VisitesGlobales.CN_Plan) AS SommeDeCN_Plan, Sum(VisitesGlobales.CN_Real) AS SommeDeCN_Real "
    vSql = vSql & "FROM VisitesGlobales "
    vSql = vSql & "GROUP BY VisitesGlobales.Ptrv;"
    Set vQuerySave = CurrentDb.CreateQueryDef(cReqVisitesGlobales, vSql)
    AccessApp.DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, cReqVisitesGlobales, vPathDataTCD, True
 
 
    ' Requête Visites S
    vSql = "SELECT VisitesGlobales.Ptrv, Sum(VisitesGlobales.CN_Plan) AS SommeDeCN_Plan, Sum(VisitesGlobales.CN_Real) AS SommeDeCN_Real "
    vSql = vSql & "FROM VisitesGlobales "
    vSql = vSql & "WHERE VisitesGlobales.TypeVisite Like ""YGE_ELE_S*S*"" "
    vSql = vSql & "GROUP BY VisitesGlobales.Ptrv;"
    Set vQuerySave = CurrentDb.CreateQueryDef(cReqVisitesS, vSql)
    AccessApp.DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, cReqVisitesS, vPathDataTCD, True
 
    ' Requête Visites I
    vSql = "SELECT VisitesGlobales.Ptrv, Sum(VisitesGlobales.CN_Plan) AS SommeDeCN_Plan, Sum(VisitesGlobales.CN_Real) AS SommeDeCN_Real "
    vSql = vSql & "FROM VisitesGlobales "
    vSql = vSql & "WHERE VisitesGlobales.TypeVisite = ""YGE_ELE__I"" "
    vSql = vSql & "GROUP BY VisitesGlobales.Ptrv;"
    Set vQuerySave = CurrentDb.CreateQueryDef(cReqVisitesI, vSql)
    AccessApp.DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, cReqVisitesI, vPathDataTCD, True
 
 
    ' -----------------------------------------------------------------
    ' ----- Compactage, suppression des tables et requêtes Access -----
    ' -----------------------------------------------------------------
 
    With AccessApp.DoCmd
        .DeleteObject acQuery, cReqVisitesGlobales
        .DeleteObject acQuery, cReqVisitesS
        .DeleteObject acQuery, cReqVisitesI
        .DeleteObject acTable, cTableName
    End With
 
    AccessApp.CloseCurrentDatabase
 
'    AccessApp.CompactRepair Environ("Userprofile") & cPathAccess, Environ("Userprofile") & cPathAccessRepaired, False
'    With fso
'        .DeleteFile Environ("Userprofile") & cPathAccess
'        .MoveFile Environ("Userprofile") & cPathAccessRepaired, Environ("Userprofile") & cPathAccess
'    End With
 
    Set AccessApp = Nothing
    Set wbTCDDataVisites = Nothing
 
End Sub