Bonjour,

J'ai un problème d'autorisation que j'ai du mal à comprendre.

Dans un module standard, j'ai une fonction qui me permet d'importer les données dans la nouvelle structure. Sauf qu'une fois la fonction fcnImportData exécuté une fois, je ne peux plus enregistrer les modifications apportées au module. J'obtiens le message suivant :

"Vous n'avez pas les autorisations nécessaires pour accéder à la base de données. Si vous faites des modifications, elles ne pourront pas être enregistrées."

Pour continuer à coder, je dois réouvrir tout mon projet. C'est la ligne CurrentDB qui place un lock quelconque sur ma base actuelle, y compris, probablement, le module standard sur lequel je travaille. Ce que j'ai dû mal à comprendre, c'est pourquoi ce lock n'est-il pas levé à la fermeture/libération de m_dbOld?

Merci!


Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Public Function fncImportData()
 
    'Initialiser les variables globales
    On Error GoTo ErrGestionOpenDb
        Set m_dbOld = OpenDatabase(CurrentProject.Path & "\" & m_cstrOldDatabasePath, True, True)
    On Error GoTo 0
 
    Set m_dbCurrent = CurrentDb
 
'    'Suprimer les données de tests   'EN COMMENTAIRE JUSTE POUR TESTER
'    fncDeleteAll
'
'    'Importer les données
'    fncImportComputers
'    fncImportMonitors
'    fncImportPrinters
'    fncImportUsers
'    fncImportEmail
 
ExitFunction:
    m_dbOld.Close
    m_dbCurrent.Close
    Set m_dbOld = Nothing
    Set m_dbCurrent = Nothing
    Exit Function
 
ErrGestionOpenDb:
    Select Case err.Number
        Case 3024
            MsgBox "La base de données est introuvable. Emplacement attendu: «" & CurrentProject.Path & "\" & m_cstrOldDatabasePath & "»"
        Case 3356
            MsgBox "La base de données est déjà ouverte. Veuillez la fermer et relancer l'importation." & vbCrLf & vbCrLf & CurrentProject.Path & "\" & m_cstrOldDatabasePath
        Case Else   'Erreur non gérée
            err.Raise err.Number
    End Select
    Resume ExitFunction
End Function