Macro sous Access - Probleme pour fermer EXCEL

Question

Bonjour,


Je suis actuellement en train d'&#233;laborer une macro ( VBA ) qui s'ex&#233;cute &#224; partir d'Access et qui va chercher des informations dans des classeurs Excel afin de les enregistrer dans ma base Access.
La recherche des fichiers se passent relativement bien. Le seul probl&#232;me, malheureusement de taille, est la gestion d'allocation de m&#233;moire pour l'application Excel. En effet bien qu'essayant de fermer Excel apr&#232;s chaque ouverture de ficher la m&#233;moire allou&#233; &#224; Excel ne cesse d'augmenter jusqu'&#224; saturation et donc planter mon PC.
L'augmentation de m&#233;moire par ouverture de fichier est insignifiante individuellement mais ma recherche se fait sur plus de 3 000 fichiers Excel.
&#201;tant plus que d&#233;butant dans la programmation (tout langage confondu) et bien qu'ayant fait des recherches, je n'arrive pas &#224; introduire l'ordre de fermer Excel sans faire planter la macro.
En clair : A L'aide
Merci d'avance pour toute aide
Vous trouverez ci-joint la macro en question
Frank

Option Compare Database
Dim f, fs, i
Dim positiondernierslash, PositionAvantdernier
Dim nomcherch&#233;, nomclasseur
------------------------------------------------------------------------------------------------------------------------


Private Sub Commande0_Click()
'lance la requete nomm&#233;e SUPPRESSION (voir les requetes enregistr&#233;es)


DoCmd.OpenQuery "suppression", acNormal, acEdit

 With Application.FileSearch    ' le End With est en bas
 ' pr&#233;ciser ici le chemin d'acc&#232;s le plus proche de l'ensemble de vos classeurs
.LookIn = "[file://\CYL\FY05\ \CYL\FY05\]"
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
.Execute

For i = 1 To .FoundFiles.Count
 ------------------------------------------------------------------------------------------------------------------------   
    'calcule la position et r&#233;cup&#232;re le nom du r&#233;pertoire imm&#233;diatement pr&#233;c&#233;dent et du classeur
    
    positiondernierslash = InStrRev(.FoundFiles.Item(i), "")
    PositionAvantdernier = InStrRev(.FoundFiles.Item(i), "", positiondernierslash - 1)
    
    nomcherch&#233; = Mid(.FoundFiles.Item(i), PositionAvantdernier + 1, (positiondernierslash - PositionAvantdernier) - 1)
    nomclasseur = Right(.FoundFiles.Item(i), Len(.FoundFiles.Item(i)) - (positiondernierslash))
    
-------------------------------------------------------------------------------------------------------------------------    
    ' Identifie la date de cr&#233;ation ou de modification la plus ant&#233;rieure
    
    Set fs = CreateObject("scripting.filesystemobject")
    Set f = fs.getfile(.FoundFiles.Item(i))
    
    If f.datelastmodified > f.DateCreated Then
    plusanciennedate = f.DateCreated
    Else
    plusanciennedate = f.datelastmodified
    End If
     Set f = Nothing
    
 ------------------------------------------------------------------------------------------------------------------------   
    
    Workbooks.Open .FoundFiles.Item(i)
  
    On Error GoTo pasbon
  
    Worksheets("home").Activate
         
    DoCmd.GoToRecord , , acNewRec  ' avant chaque lecture, ouvre un nouvel enregistrement
    
    Me.datecreation = plusanciennedate
    Me.Nom_Client = Range("AE14")
    Me.Raison_WB = Range("AE10")
    Me.Raison_Changement_Prix = Range("AE12")
    Me.dossier = nomcherch&#233;
        
continuer:


'referme le classeur sans le sauvegarder et sans routage


   Workbooks(nomclasseur).Close False, , False


Next   'classeur suivant


End With


Exit Sub


'D&#233;but de la gestion d'erreur
'concerne uniquement les classeur dont la feuille HOME n'est pas trouv&#233;e


pasbon:


Resume continuer
End Sub

valtrase · Answer

Salut,
Dans ton code tu fermes bien ton classeur mais pas ton application donc excel reste en m&#233;moire. donc le mieux c'est de tester en d&#233;but si excel et charg&#233; si oui tu l'utilises si non tu cr&#233;e un object Excel

Voil&#224; un bout de code VB6 que tu peux adapter &#224; ton cas

Dim appExcel As Object              'Application Excel
Dim wbExcelModel As Excel.Workbook  'Classeur Excel
Dim wsExcel As Excel.WorkSheet
Dim blRunning As Boolean            'Utilis&#233; pour m&#233;moris&#233; l'&#233;tat d'Excel au d&#233;marage


On Error Resume Next                  'Utilis&#233; pour v&#233;rifier si Excel s'&#233;x&#233;cute


Screen.MousePointer = ccHourglass
                                                      'V&#233;rifie si Excel est ouvert
Set appExcel = GetObject(, "Excel.Application") If Err.Number <> 0 Then
        blRunning = False                   'Excel n'&#233;tait pas en &#233;xecution
        Set appExcel = CreateObject("Excel.Application")
Else
        blRunning = True
End If
Err.Clear

On Error GoTo Command1_Click_Error

                                             'Ici on ajoute un classeur
Set wbExcelModel = appExcel.Workbooks.Add(MonWorkBook)
                                                 'Quand tu ne te serts plus d'excel
                                                  'Penser &#224; le fermer
appExcel.Quit
appExcel = Nothing
wbExcelModel =Nothing
wsExcel = Nothing

Cordialement, Jean-Paul  
______________________________________________________________________

Le Savoir n'a de valeur que s'il est partag&#233;

Macro sous Access - Probleme pour fermer EXCEL

1 réponse

Discussions similaires