Discussion :

[snooopy007]

Bonjour

Je suis en train de faire une Base de données access de laquelle, je lis une feuille excell pour trouver les données à insérer dans cette BD. J'ouvre la feuille excell, je fais quelques manipulations et je referme le tout à la fin mais malheureusement, la mémoire ne se vide pas bien car il me reste encore plusieurs processus après avoir fini d'encoder mes données.

Voici mon 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
Private Sub bout_ouvre_enco_vrco_Click()
    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook
    Dim test As String
    Dim MyQuery As String
 
    On Error GoTo Error_encodage
 
    Set xlApp = CreateObject("Excel.Application")
 
    Set xlBook = xlApp.Workbooks.Open("O:\bdcreuset1.1\export_v1-3.xls")
    Set xlSheet = xlBook.Worksheets("Sheet1")
    MsgBox ("fin sheet")
 
    MyQuery = "INSERT INTO melting_program (file_name, requester, glass_project, program_objective, crucible_type, furnace_number, atmosphere, account, week, nbre_coulees, comment) Values "
    MsgBox ("5.6 =" & xlSheet.Cells(5, 6))
    MyQuery = MyQuery & "(" & Chr(34) & xlSheet.Cells(5, 6) & Chr(34) & ", " & Chr(34) & xlSheet.Cells(4, 6) & Chr(34) & ", " & Chr(34) & xlSheet.Cells(3, 2) & Chr(34) & ", " & Chr(34) & xlSheet.Cells(4, 2) & Chr(34) & ", " & Chr(34) & xlSheet.Cells(5, 2) & Chr(34) & ", " & xlSheet.Cells(9, 2) & ", " & Chr(34) & xlSheet.Cells(10, 2) & Chr(34) & ", " & Chr(34) & xlSheet.Cells(7, 2) & Chr(34) & ", " & Chr(34) & xlSheet.Cells(8, 2) & Chr(34) & ", " & xlSheet.Cells(6, 2) & ", " & Chr(34) & xlSheet.Cells(9, 6) & Chr(34) & ")"
    MsgBox ("query =    " & MyQuery)
    DoCmd.RunSQL MyQuery
    MsgBox ("ok")
    xlApp.Quit
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    Exit Sub
 
Error_encodage:
    MsgBox Error$
    Set xlSheet = Nothing
    Set xlBook = Nothing
    xlApp.Quit
    Set xlApp = Nothing
    Exit Sub
 
End Sub

Pourquoi la mémoire ne se vide pas bien? Merci de m'aider.

[LedZeppII]

Bonsoir,

Je ne saurais pas te dire pourquoi, mais je l'ai déjà constaté.
Essaie de déplacer DoCmd.RunSQL MyQuery après xlApp.Quit
Mon impression (peut-être fausse) c'est que, dès qu'on utilise un DoCmd entre
Set xlApp = CreateObject("Excel.Application")
et
xlApp.Quit
le Quit d'Excel échoue.

Bon courage

[mat.M]

L'explication que l'on pourrait donner est que tu veux femer Excel par xlApp.Quit mais la requete lancée par DoCmd.RunSQL MyQuery n'est pas terminée.
Donc il faut trouver un moyen pour s'assurer que la requête traitée par Excel soit bien révolue et fermer à cette condition seule Excel.
Parce que Access en interne continue au niveau des appels d'instructions et ne se préoccupe pas de savoir si DoCmd.RUNSQL est terminé

[pgz]

Bonsoir,

Peut-être un DoEvents après le DoCmd...

pgz

[snooopy007]

J'ai changé mon code pour éviter l'usage de Docmd.RunSQL mais cela ne change rien, j'ai toujours un processus Excel qui se crée à chaque exécution mais qui ne se termine jamais.

Je ne comprends vraiment pas.

Voici mon 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
Private Sub bout_ouvre_enco_vrco_Click()
    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook
    Dim test As String
    Dim prog_id As Integer
    Dim rst As DAO.Recordset
 
    On Error GoTo Error_encodage
 
    Set xlApp = CreateObject("Excel.Application")
 
 
 
    Set xlBook = xlApp.Workbooks.Open("O:\bdcreuset1.1\export_v1-3.xls")
    Set xlSheet = xlBook.Worksheets("Sheet1")
 
 
    '********************************
    'Remplissage de melting_program
    '********************************
 
    'on vérifie qu'il y a au moins un test_id
    If (IsEmpty(xlSheet.Cells(12, 2)) And IsEmpty(xlSheet.Cells(12, 3)) And IsEmpty(xlSheet.Cells(12, 4)) ) Then
        MsgBox ("Tous les test id sont nulls, veuillez au moins en remplir un. Merci")
        Exit Sub
    End If
 
    Set rst = CurrentDb.OpenRecordset("Select * from melting_program")
    rst.MoveLast
    prog_id = rst.Fields("program_id") + 1
    'MsgBox (prog_id)
 
    rst.AddNew
    'Affecte les différents champs
    rst.Fields("program_id").Value = prog_id
    rst.Fields("file_name").Value = xlSheet.Cells(5, 6)
    rst.Fields("requester").Value = xlSheet.Cells(4, 6)
    rst.Fields("glass_project").Value = xlSheet.Cells(3, 2)
    rst.Fields("program_objective").Value = xlSheet.Cells(4, 2)
    rst.Fields("crucible_type").Value = xlSheet.Cells(5, 2)
    rst.Fields("furnace_number").Value = xlSheet.Cells(9, 2)
    rst.Fields("atmosphere").Value = xlSheet.Cells(10, 2)
    rst.Fields("account").Value = xlSheet.Cells(7, 2)
    rst.Fields("week").Value = xlSheet.Cells(8, 2)
    rst.Fields("nbre_coulees").Value = xlSheet.Cells(6, 2)
    rst.Fields("debit_athm").Value = xlSheet.Cells(6, 6)
    rst.Fields("comment").Value = xlSheet.Cells(9, 6)
    'Met à Jour
    rst.Update
 
    rst.Close
    Set rst = Nothing
 
    '*********************************
    'Remplissage de melting_test
    '*********************************
 
    Set rst = CurrentDb.OpenRecordset("Select * from melting_test")
 
    MsgBox ("begin melting test")
 
    If Not (IsEmpty(xlSheet.Cells(12, 2))) Then
        rst.AddNew
        'Affecte les différents champs
        rst.Fields("test_id").Value = xlSheet.Cells(12, 2)
        rst.Fields("prog_id").Value = prog_id
        rst.Fields("comment").Value = xlSheet.Cells(13, 2)
        'Met à Jour
        rst.Update
    End If
    rst.Close
    Set rst = Nothing
 
 
    xlApp.Quit
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    Exit Sub
 
Error_encodage:
    MsgBox Error$
    xlApp.Quit
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    Exit Sub
 
End Sub

Merci d'avance pour votre aide.

[Arkham46]

Slt,

Peut-être que Excel attend une réponse à une boîte de dialogue du style "Voulez-vous enregistrer le classeur...?"
Essaie de rajouter :

Code :

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

xlApp.Visible = True

Comme ça tant que tu es en développement tu vois ce qui se passe exactement. Ensuite tu enlèves cette ligne quand tout est correct.