Erreur: 1004 Excel ne peut pas accéder à 'MON XL'. Le document est peut-être en lecture seule ou chiffré

**glbaa** · 04/11/2013, 13h11

Bonjour à tous,

Je me suis inspiré des différents tutoriels sur le site pour mettre en place un programme qui depuis un formulaire Access ouvre un fichier Excel et effectue des opérations sur celui-ci.

Mon probléme c'est que depuis quelques jours j'ai l'erreur suivante :
Erreur: 1004 Excel ne peut pas accéder à 'MON XL'. Le document est peut-être en lecture seule ou chiffré.

Le programme a été testé et le code fonctionne normalement. Depuis quelques jours, j'ai cette erreur qui s'affiche et je ne comprend pas trop pourquoi! j'ai demandé à être administrateur de mon poste mais rien n'a changé !

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
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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
 
Private Sub BtnImport_Click()
 
Dim SQL As String
Dim f As Boolean
Dim x As Boolean
 
CurrentDb.Execute "Delete From [Stock_PBE]"
 
x = OuvrirUnFichier(Application.hWndAccessApp, "Parcourir", "Fichier Excel", "xlsx", "D:\Users\u132239\Desktop\Stock PBE S44")
 
If (f = True) Then
    SQL = "INSERT INTO Stock_PBE_Archive SELECT * FROM Stock_PBE;"
    DoCmd.RunSQL SQL
End If
 
End Sub
Function ImportXL(xlPath As String, wsName As String, startRow As Integer, pKeyCol As String, acTable As String, pKey As String) As Boolean
'-> La fonction renvoie vrai si l'import réussit et faux dans le cas contraire
'xlPath : chemin du fichier Excel
'wsName : nom de la feuille Excel qui contient les données à importer
'startRow : ligne du fichier Excel où commence l'import
'pKeyCol : colonne du fichier Excel qui est la clé primaire de la table Access
'acTable : table Access qui reçoit les données
'pKey : nom du champ "identifiant"
 
 
 
 
    'active la routine de gestion d'erreur.
    On Error GoTo erreur
 
    'déclaration des variables
    Dim app As Excel.Application
    Dim wkb As Excel.Workbook
    Dim wks As Excel.Worksheet
 
    'initialisation des variables
    Set app = New Excel.Application
    Set wkb = app.Workbooks.Open(xlPath)
    Set wks = wkb.Worksheets(wsName)
 
    Dim i As Integer, cSQL As String
    i = startRow
 
    'pour éviter les messages lors de l'ajout des enregistrements
    DoCmd.SetWarnings False
 
    With wks
        'arrêter l'importation lorsque l'on rencontre une case vide
        While .Range(pKeyCol & i).Value <> "" '(où pKeyCol représente la colonne et i la ligne)
 
            'condition de remplissage de la table => eviter les doublons
            'si l'enregistrement existe déjà dans la table destination,
            'on passe à la ligne suivante sans l'importer
            If DCount("*", acTable, pKey & " LIKE '" & .Range(pKeyCol & i).Value & "'") = 0 Then
 
                'requête SQL (ajouter autant de champs que nécessaire)
              ' cSQL = "INSERT INTO " & acTable & " ( [ID], [Client],[Site],[Nom Usuel Site],[Alerte]) VALUES (" & Chr(34) & .Range("A" & i) & Chr(34) & "," & Chr(34) & .Range("B" & i) & Chr(34) & "," & Chr(34) & .Range("C" & i) & Chr(34) & "," & Chr(34) & .Range("D" & i) & Chr(34) & "," & Chr(34) & .Range("F" & i) & Chr(34) & ");"
           cSQL = "INSERT INTO " & acTable & " ( [ID], [Client],[Site],[Nom Usuel Site],[Alerte],[Age Tâche],[Code Postal],[Ville],[Offre],[BdsId],[MasterId],[Login Manager],[Login Cdp],[Login Ordo],[Date Cible],[Etat Site],[Working Step Détaillé],[Tâche],[Equipe Acteur],[Installateur],[Référence Commande],[Date Installation Planifiée],[Délai Depuis Signature],[Working Step]) VALUES (" & Chr(34) & .Range("A" & i) & Chr(34) & "," & Chr(34) & .Range("B" & i) & Chr(34) & "," & Chr(34) & .Range("C" & i) & Chr(34) & "," & Chr(34) & .Range("D" & i) & Chr(34) & "," & Chr(34) & .Range("F" & i) & Chr(34) & "," & Chr(34) & .Range("G" & i) & Chr(34) & "," & Chr(34) & .Range("H" & i) & Chr(34) & "," & Chr(34) & .Range("I" & i) & Chr(34) & ", " _
                & "" & Chr(34) & .Range("J" & i) & Chr(34) & "," & Chr(34) & .Range("L" & i) & Chr(34) & "," & Chr(34) & .Range("M" & i) & Chr(34) & "," & Chr(34) & .Range("N" & i) & Chr(34) & "," & Chr(34) & .Range("O" & i) & Chr(34) & "," & Chr(34) & .Range("P" & i) & Chr(34) & "," & Chr(34) & .Range("Q" & i) & Chr(34) & "," & Chr(34) & .Range("R" & i) & Chr(34) & ", " _
                & "" & Chr(34) & .Range("S" & i) & Chr(34) & "," & Chr(34) & .Range("T" & i) & Chr(34) & "," & Chr(34) & .Range("U" & i) & Chr(34) & "," & Chr(34) & .Range("V" & i) & Chr(34) & "," & Chr(34) & .Range("W" & i) & Chr(34) & "," & Chr(34) & .Range("X" & i) & Chr(34) & "," & Chr(34) & .Range("AA" & i) & Chr(34) & "," & Chr(34) & .Range("AB" & i) & Chr(34) & ");"
 
 
                'exécute la requète
                DoCmd.RunSQL cSQL
 
            End If
 
            'on incrémente la variable i pour passer à la ligne suivante
            i = i + 1
        Wend
 
    End With
 
    'on réactive les messages d'erreurs
    DoCmd.SetWarnings True
 
    'libération variables
    Set wks = Nothing
    Set wkb = Nothing
    Set app = Nothing
 
    MsgBox "Import du fichier Excel réussi.", vbInformation + vbOKOnly, "Opération terminée..."
 
 
 
    ImportXL = True
    Exit Function
 
erreur:    ' Routine de gestion d'erreur.
    MsgBox "Erreur: " & Err.Number & vbCrLf & Err.Description, vbOKOnly + vbInformation
    ImportXL = False
End Function
Public Function OuvrirUnFichier(Handle As Long, _
                                Titre As String, _
                                Optional TitreFiltre As String, _
                                Optional TypeFichier As String, _
                                Optional RepParDefaut As String) As Boolean
 ' OuvrirUnFichier est la fonction à utiliser dans votre formulaire pour ouvrir _
 ' la boîte de dialogue de sélection d'un fichier.
 ' Explication des paramètres
    ' Handle = le handle de la fenêtre
    ' Titre = titre de la boîte de dialogue
    ' TypeRetour (définit la valeur, de type String, renvoyée par la fonction)
        ' 1 = chemin complet + nom du fichier
        ' 2 = nom fichier seulement
    ' TitreFiltre = titre du filtre
        ' Exemple: fichier Access
        ' N'utilisez pas cet argument si vous ne voulez spécifier aucun filtre
    ' TypeFichier = extention du fichier (sans le .)
        ' Exemple: MDB
        ' N'utilisez pas cet argument si vous ne voulez spécifier aucun filtre
    ' RepParDefaut = répertoire d'ouverture par défaut
        ' Exemple: C:\windows\system32
        ' Si vous laissez l'argument vide, par défaut il se place dans le répertoire de votre application
 
Dim StructFile As OPENFILENAME
Dim sFiltre As String
Dim f As Boolean
Dim MonChemin As String
Dim MonXL As String
 
 
 ' Construction du filtre en fonction des arguments spécifiés
If Len(TitreFiltre) > 0 And Len(TypeFichier) > 0 Then
  sFiltre = TitreFiltre & " (" & TypeFichier & ")" & Chr$(0) & "*." & TypeFichier & Chr$(0)
End If
sFiltre = sFiltre & "Tous (*.*)" & Chr$(0) & "*.*" & Chr$(0)
 
 
 ' Configuration de la boîte de dialogue
  With StructFile
    .lStructSize = Len(StructFile) ' Initialisation de la grosseur de la structure
    .hwndOwner = Handle ' Identification du handle de la fenêtre
    .lpstrFilter = sFiltre ' Application du filtre
    .lpstrFile = String$(254, vbNullChar) ' Initialisation du fichier '0' x 254
    .nMaxFile = 254 ' Taille maximale du fichier
    .lpstrFileTitle = String$(254, vbNullChar) ' Initialisation du nom du fichier '0' x 254
    .nMaxFileTitle = 254  ' Taille maximale du nom du fichier
    .lpstrTitle = Titre ' Titre de la boîte de dialogue
    .flags = OFN_HIDEREADONLY  ' Option de la boite de dialogue
    If ((IsNull(RepParDefaut)) Or (RepParDefaut = "")) Then
        RepParDefaut = CurrentDb.Name
        PathStripPath (RepParDefaut)
        .lpstrInitialDir = Left(CurrentDb.Name, Len(CurrentDb.Name) - Len(Mid$(RepParDefaut, 1, _
InStr(1, RepParDefaut, vbNullChar) - 1)))
        Else: .lpstrInitialDir = RepParDefaut
    End If
  End With
 
If (GetOpenFileName(StructFile)) Then ' Si un fichier est sélectionné
    MonXL = Trim$(Left(StructFile.lpstrFileTitle, InStr(1, StructFile.lpstrFileTitle, vbNullChar) - 1))
    MonChemin = Trim$(Left(StructFile.lpstrFile, InStr(1, StructFile.lpstrFile, vbNullChar) - Len(MonXL) - 2))
    'MsgBox MonChemin
    OuvrirUnFichier = True
    Else
    OuvrirUnFichier = False
    MsgBox "Erreur: Aucun Fichier selectionné " & Err.Number & vbCrLf & Err.Description, vbOKOnly + vbInformation
    End If
 
 If OuvrirUnFichier = True Then
 f = ImportXL(MonChemin, MonXL, 2, "A", "Stock_PBE", "ID")
End If
End Function

Le programme bloque au niveau de l'initialisation des variables:
Set wkb = app.Workbooks.Open(xlPath)

Merci d'avance pour votre aide.

**marsouin_89** · 04/11/2013, 19h44

Bonsoir,

C'est certainement dû au fait que ton instance Excel reste ouverte après ton traitement.
Avant la libération de tes variables, il te faut donc fermer Excel.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
App.DisplayAlerts = False 'Le message d'enregistrement est désactivé
wkb.Close True 'Fermer le fichier et l'enregistre sans message de confirmation dû à xlapp.DisplayAlerts=false
App.Quit 'Fermerture d'excel
App.DisplayAlerts = True 'Le message d'enregistrement est réactivé

Cordialement

Christophe

**glbaa** · 05/11/2013, 11h15

Bonjour,
Je te remercie pour ta réponse. J'ai placé ton code avant la libération des variables comme tu m'avais conseillé mais j'ai toujours la même erreur!

En fait le traitement ne se fait même pas puisque l’exécution bloque au niveau de l’initiation de la variable : Set wkb = app.Workbooks.Open(xlPath)

Excel n'arrive pas à accéder au dossier pourtant j'ai vérifie les droits d’accès du dossier en question!

cordialement

**marsouin_89** · 06/11/2013, 19h18

Bonsoir,

Au temps pour moi, j'ai mal regardé ton code.

Au lieu de :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set App =New Excel.Application

Ecrire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set App = CreateObject("Excel.Application")

Cela aura pour objet de te créer une nouvelle instance Excel.

Cordialement

Christophe

**micniv** · 06/11/2013, 23h21

Bonsoir,
Vérifie s'il n'y a pas des procces Excel qui tournent encore dans le Gestionnaire des taches
puis essaie plutôt de fermer le classeur avant de liberer la mémoire :
donc

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
...
wkb.close
 
' avant le
set wkb= nothing

Bonne suite

Erreur: 1004 Excel ne peut pas accéder à 'MON XL'. Le document est peut-être en lecture seule ou chiffré

Access

Discussions similaires

Partager

Partager