Gestion instable de fichier Excel manipulé sous access

**shakapouet** · 16/07/2012, 12h39

Bonjour,

J'ai développé une macro qui me permet d'ouvrir un fichier type DQY et mettre à jour ma base de donnée avec. Tout fonctionne très bien, mais parfois il m'arrive d'avoir des erreurs d’exécution. Etant donné que ça va devenir une tache planifié qui tournera la nuit, ça serait bien qu'il n'y ai aucune erreur.

Je vous explique le contexte :

J'ouvre un fichier de type DQY, ensuite je j'enregistre une sauvegarde au format Excel dans un dossier d'archive. Puis sur ce nouveaux fichier que je vien d'enregistrer, je parcoure la liste et j'ajoute les nouvelles donnée manquante dans la base.

Les erreur auquel je fais face sont celle ci :

Erreur d'exécution 1004 : La méthode Range de l'objet_ GLOBAL à échoué

Code :

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

1
2
3
    With ActiveSheet.QueryTables.Add(Connection:= _
        "FINDER;" & ledir_bdcf & fichier_bdcf_aval & "", _
        Destination:=Range("A1"))

Voici le code complet :

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
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
Private Sub Commande0_Click()
 
    chrono = CDate(Time)
    MsgBox chrono
 
    ledir = CurrentProject.Path & "\"
    ledir_bdcf = CurrentProject.Path & "\bdcf\"
    ledir_tracking = CurrentProject.Path & "\tracking\"
 
    fichier_bdcf_model = "model_bdcf.xls"""
    fichier_bdcf_aval = "BDCAvalExtract.dqy"
    fichier_bdcf_amont = "BDCAmontExtract.dqy"
    fichier_tracking = "xxxxx.xlsm"
 
 
   Call extraction_dqy_aval(fichier_bdcf_aval, ledir_bdcf)
  '  Call extraction_dqy_amont(fichier_bdcf_amont, ledir_bdcf)
   ' Call extraction_excel_tracking(fichier_tracking, ledir_tracking)
 
    chrono2 = CDate(Time)
    MsgBox CDate(chrono2 - chrono)
 
End Sub
 
Private Sub extraction_dqy_aval(fichier_bdcf_aval, ledir_bdcf)
 
 
    Dim xlAppAs As Variant, xlBook As Variant, xlSheet As Variant, xlPath As String, wsName As String, startRow As Integer, pkeycol As String, acTable As String, pkey As String
    Dim str As String
 
 
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open("" & ledir_bdcf & fichier_bdcf_aval & "")
    Set xlSheet = xlBook.Worksheets("BDCAvalExtract")
    xlApp.Visible = True
 
    choix = "aval"
 
 
    'On lance l'éxécution du fichier DQY
    With ActiveSheet.QueryTables.Add(Connection:= _
        "FINDER;" & ledir_bdcf & fichier_bdcf_aval & "", _
        Destination:=Range("A1"))
        .Name = "bdcf_aval"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
 
 
    End With
 
    timestamp = Format(Now, "dd-mm-yyyy-hhnnssms")
    fichier_final = "bdcf_aval_MAJ_" & timestamp & ".xls"
    xlPath = "" & ledir_bdcf & "Archive\" & fichier_final & ""
    wsName = "BDCAvalExtract"
    startRow = 2
    pkeycol = "C"
    acTable = "BDCF_AVAL"
 
    xlBook.SaveAs xlPath
 
    xlBook.Close
    xlApp.Quit
 
    Set xlBook = Nothing
    Set xlApp = Nothing
 
 
    Call ImportXL_BDCF_UPDTATE(xlPath, wsName, startRow, pkeycol, acTable, choix)
 
 
Function ImportXL_BDCF_UPDTATE(xlPath, wsName, startRow, pkeycol, acTable, choix)
 
 
 
    '-> 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
 
    date_du_jour = Date
    date_du_jour = CDate(date_du_jour)
 
    If choix = "amont" Then
        date_dernier_record = Liste6.ItemData(0)
        If date_dernier_record <> "" Then
            date_dernier_record = CDate(date_dernier_record)
        End If
    Else
        date_dernier_record = Liste8.ItemData(0)
        If date_dernier_record <> "" Then
            date_dernier_record = CDate(date_dernier_record)
        End If
    End If
 
    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)
 
        If date_dernier_record <> "" Then
            If CDate(Left(Range(pkeycol & i).Value, 10)) > date_dernier_record Then
                If CDate(Left(Range(pkeycol & i).Value, 10)) <= date_du_jour Then
                       '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 choix = "aval" Then
                             'requête SQL (ajouter autant de champs que nécessaire)
                             cSQL = "INSERT INTO " & acTable & " ( [CodeEntrepot], [LibelleEntrepot], [Date_incident], [CodeType1], [LibelleType1], [CodeType2], [LibelleType2], [CodeType3], [LibelleType3], [LibelleGroupage], [CodeTransporteur], [LibelleTransporteur], [LibelleActivite], [CodeMagasin], [LibelleMagasin], [LibelleMAJ], [LibelleObservation]) 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("E" & 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("K" & 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) & ");"
                            'exécute la requète
                            DoCmd.RunSQL cSQL
                        ElseIf choix = "amont" Then
                            cSQL = "INSERT INTO " & acTable & " ([CodeEntrepot], [LibelleEntrepot], [Date_incident], [CodeType1], [LibelleType1], [CodeType2], [LibelleType2], [CodeType3], [LibelleType3], [CodeTransporteur], [LibelleTransporteur], [LibelleActivite], [CodeFournisseur], [LibelleFournisseur], [LibelleMAJ], [LibelleObservation]) 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("E" & 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("K" & 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) & ");"
                            'exécute la requète
                            DoCmd.RunSQL cSQL
                        End If
                End If
            End If
        Else
          If CDate(Left(Range(pkeycol & i).Value, 10)) <= date_du_jour Then
                 If choix = "aval" Then
                     'requête SQL (ajouter autant de champs que nécessaire)
                     cSQL = "INSERT INTO " & acTable & " ( [CodeEntrepot], [LibelleEntrepot], [Date_incident], [CodeType1], [LibelleType1], [CodeType2], [LibelleType2], [CodeType3], [LibelleType3], [LibelleGroupage], [CodeTransporteur], [LibelleTransporteur], [LibelleActivite], [CodeMagasin], [LibelleMagasin], [LibelleMAJ], [LibelleObservation]) 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("E" & 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("K" & 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) & ");"
                    'exécute la requète
                    DoCmd.RunSQL cSQL
                ElseIf choix = "amont" Then
                    cSQL = "INSERT INTO " & acTable & " ([CodeEntrepot], [LibelleEntrepot], [Date_incident], [CodeType1], [LibelleType1], [CodeType2], [LibelleType2], [CodeType3], [LibelleType3], [CodeTransporteur], [LibelleTransporteur], [LibelleActivite], [CodeFournisseur], [LibelleFournisseur], [LibelleMAJ], [LibelleObservation]) 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("E" & 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("K" & 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) & ");"
                    'exécute la requète
                    DoCmd.RunSQL cSQL
                End If
            End If
        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
 
    wkb.Close
    app.Quit
 
    '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

Je ne c'est pas si cela est due à une mauvais fermeture de mes applications Excel. Voila si quelqu’un à une idée.

Cordialement

**Jean-Philippe André** · 16/07/2012, 17h40

salut,

l'objet VBA Range est spécifique à Excel, aussi si tu veux y faire référence.
- soit tu ajoutes la référence Excel à ton projet.
- soit tu passes par l'intégralité de ta chaîne alimentaire :

Code :

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

...ActiveSheet.Range("A1")...

**shakapouet** · 16/07/2012, 18h38

Merci de ta réponse.
J'ai un peut avancer le sujet, mon problème est légèrement différent maintenant.

L'exécution des mise à jours dans ma base fonctionne parfaitement, le problème est lorsque je veut enchaîner la mise à jour de mes fichiers.

Je m'explique , je lancer d'abord la mise à jour de mon DQY amont. Cela marche très bien. Ensuite quand j'enchaine sur la mise à jour de mon DQY aval, j'ai une erreur du type :

Erreur d'exécution 1004 : La méthode Range de l'objet_ GLOBAL à échoué

Par contre si je lance une fonction l'une après l'autre cela fonctionne très bien.

Voici le code :

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
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
Private Sub Commande0_Click()
 
    chrono = CDate(Time)
    MsgBox chrono
 
    ledir = CurrentProject.Path & "\"
    ledir_bdcf = CurrentProject.Path & "\bdcf\"
    ledir_tracking = CurrentProject.Path & "\tracking\"
 
    fichier_bdcf_model = "model_bdcf.xls"""
    fichier_bdcf_aval = "BDCAvalExtract.dqy"
    fichier_bdcf_amont = "BDCAmontExtract.dqy"
    fichier_tracking = "cube_ponctualité_V3.xlsm"
 
  '  Call extraction_dqy_amont(fichier_bdcf_amont, ledir_bdcf)
    Call extraction_dqy_aval(fichier_bdcf_aval, ledir_bdcf)
 
   ' Call extraction_excel_tracking(fichier_tracking, ledir_tracking)
 
    chrono2 = CDate(Time)
    MsgBox CDate(chrono2 - chrono)
 
End Sub
 
 
Function extraction_dqy_amont(fichier_bdcf_amont, ledir_bdcf)
 
   DoCmd.SetWarnings False
 
    Dim xlApp As Variant, xlBook As Variant, xlSheet As Variant, xlPath As String, wsName As String, startRow As Integer, pkeycol As String, acTable As String, pkey As String
    Dim i As Integer, cSQL As String
 
 
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open("" & ledir_bdcf & fichier_bdcf_amont & "")
    Set xlSheet = xlBook.Worksheets("BDCAmontExtract")
    xlApp.Visible = True
 
    Sheets("BDCAmontExtract").Activate
 
    wsName = "BDCAmontExtract"
    startRow = 2
    pkeycol = "C"
    acTable = "BDCF_AMONT"
 
 
    i = startRow
    'pour éviter les messages lors de l'ajout des enregistrements
 
    date_du_jour = Date
    date_du_jour = CDate(date_du_jour)
 
 
    date_dernier_record = Liste6.ItemData(0)
    If date_dernier_record <> "" Then
        date_dernier_record = CDate(date_dernier_record)
    End If
 
 
    With xlSheet
        '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)
 
        If date_dernier_record <> "" Then
            If CDate(Left(Range(pkeycol & i).Value, 10)) > date_dernier_record Then
                If CDate(Left(Range(pkeycol & i).Value, 10)) <= date_du_jour Then
                       '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
                       'requête SQL (ajouter autant de champs que nécessaire)
                    cSQL = "INSERT INTO " & acTable & " ([CodeEntrepot], [LibelleEntrepot], [Date_incident], [CodeType1], [LibelleType1], [CodeType2], [LibelleType2], [CodeType3], [LibelleType3], [CodeTransporteur], [LibelleTransporteur], [LibelleActivite], [CodeFournisseur], [LibelleFournisseur], [LibelleMAJ], [LibelleObservation]) 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("E" & 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("K" & 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) & ");"
                    'exécute la requète
                    DoCmd.RunSQL cSQL
                End If
            End If
        Else
          If CDate(Left(Range(pkeycol & i).Value, 10)) <= date_du_jour Then
                    'requête SQL (ajouter autant de champs que nécessaire)
                    cSQL = "INSERT INTO " & acTable & " ([CodeEntrepot], [LibelleEntrepot], [Date_incident], [CodeType1], [LibelleType1], [CodeType2], [LibelleType2], [CodeType3], [LibelleType3], [CodeTransporteur], [LibelleTransporteur], [LibelleActivite], [CodeFournisseur], [LibelleFournisseur], [LibelleMAJ], [LibelleObservation]) 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("E" & 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("K" & 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) & ");"
                    'exécute la requète
                    DoCmd.RunSQL cSQL
            End If
        End If
 
        'on incrémente la variable i pour passer à la ligne suivante
        i = i + 1
        Wend
 
    End With
 
    xlBook.Close savechanges:=False
    xlApp.Quit
 
    Set xlBook = Nothing
    Set xlApp = Nothing
    Set xlSheet = Nothing
 
    'on réactive les messages d'erreurs
    DoCmd.SetWarnings True
 
  '  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
 
Function extraction_dqy_aval(fichier_bdcf_aval, ledir_bdcf)
 
    Dim App As Variant, Book As Variant, Sheet As Variant, xlPath As String, wsName As String, startRow As Integer, pkeycol As String, acTable As String, pkey As String
    Dim i As Integer, cSQL As String
 
    DoCmd.SetWarnings False
 
    Set App = CreateObject("Excel.Application")
    Set Book = App.Workbooks.Open("" & ledir_bdcf & fichier_bdcf_aval & "")
    Set Sheet = Book.Worksheets("BDCAvalExtract")
    App.Visible = True
 
    Sheets("BDCAvalExtract").Select
 
    timestamp = Format(Now, "dd-mm-yyyy-hhnnssms")
    wsName = "BDCAvalExtract"
    startRow = 2
    pkeycol = "C"
    acTable = "BDCF_AVAL"
 
    i = startRow
 
    date_du_jour = Date
    date_du_jour = CDate(date_du_jour)
 
 
    date_dernier_record = Liste8.ItemData(0)
    If date_dernier_record <> "" Then
        date_dernier_record = CDate(date_dernier_record)
    End If
 
    With Sheet
        '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)
 
        If date_dernier_record <> "" Then
            If CDate(Left(Range(pkeycol & i).Value, 10)) > date_dernier_record Then
                If CDate(Left(Range(pkeycol & i).Value, 10)) <= date_du_jour Then
                    '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
                     'requête SQL (ajouter autant de champs que nécessaire)
                     cSQL = "INSERT INTO " & acTable & " ( [CodeEntrepot], [LibelleEntrepot], [Date_incident], [CodeType1], [LibelleType1], [CodeType2], [LibelleType2], [CodeType3], [LibelleType3], [LibelleGroupage], [CodeTransporteur], [LibelleTransporteur], [LibelleActivite], [CodeMagasin], [LibelleMagasin], [LibelleMAJ], [LibelleObservation]) 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("E" & 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("K" & 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) & ");"
                    'exécute la requète
                    DoCmd.RunSQL cSQL
                End If
            End If
        Else
            If CDate(Left(Range(pkeycol & i).Value, 10)) <= date_du_jour Then
                 'requête SQL (ajouter autant de champs que nécessaire)
                cSQL = "INSERT INTO " & acTable & " ( [CodeEntrepot], [LibelleEntrepot], [Date_incident], [CodeType1], [LibelleType1], [CodeType2], [LibelleType2], [CodeType3], [LibelleType3], [LibelleGroupage], [CodeTransporteur], [LibelleTransporteur], [LibelleActivite], [CodeMagasin], [LibelleMagasin], [LibelleMAJ], [LibelleObservation]) 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("E" & 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("K" & 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) & ");"
                'exécute la requète
                DoCmd.RunSQL cSQL
            End If
        End If
 
        'on incrémente la variable i pour passer à la ligne suivante
        i = i + 1
        Wend
 
    End With
 
    Book.Close savechanges:=False
    App.Quit
 
    Set Book = Nothing
    Set App = Nothing
    Set Sheet = Nothing
 
    'on réactive les messages d'erreurs
    DoCmd.SetWarnings True
 
 '   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
 
  '  DoCmd.SetWarnings True
 
End Function

J'ai donc une erreur à cette endroit dans la fonction DQY aval :

Code :

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

Sheets("BDCAvalExtract").Select

Je ne comprend pas d'ou peut venir le problème.

Merci

**Jean-Philippe André** · 16/07/2012, 19h03

Je réitère ma remarque sur le fait que tu es dans Access et non pas dans Excel.
L'objet Sheets n'est pas connu dans Access comme tel, aussi il te faut spécifier le classeur parent de la feuille que tu souhaites activer.

Ici tu passeras d'un

Code :

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

Sheets("BDCAvalExtract").Select

à

Code :

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

Book.Worksheets("BDCAvalExtract").Select

tu rencontreras le même problème à chaque fois que tu tenteras de pointer sur un objet worksheet/workbook tant que tu ne passeras pas par tes variables clairement identifiées par ton code

**shakapouet** · 17/07/2012, 11h06

Merci jpcheck, ça fonctionne parfaitement.

Code :

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

Sheets("BDCAvalExtract").Select   ==>>  Book.Worksheets("BDCAvalExtract").Select

Et il fallait ajouter des " . " avant les range.

Merci beaucoup.

Gestion instable de fichier Excel manipulé sous access [AC-2010]

VBA Access

Discussions similaires

Partager

Partager