[Macro Excel] Libération d'espace mémoire ?!

Bonjour à tous,

Merci d'avoir cliqué sur ma question. Ce matin au boulot, on m'a filé une tâche horrible:

J'ai le problème suivant : On m'a donné une macro Excel qui fait un chargement en base quand je clique sur le bouton "GO!" :
- Elle se connecte à une base de données ("Perl" à première vue)
- Elle lit des fichiers
...

Mais à chaque clique sur le bouton, ça créé un nouveau processus dans Windows [voir ma copie d'écran du gestionnaire des taches ici: ---> http://img19.imageshack.us/img19/4104/sanstitreasr.jpg]

En supposant que ça viendrait d'un problème de libération mémoire, y aurait-il une commande magique pour libérer tout l'espace à la fin?

Merci d'avance si vous savez d'où ça vient.
Configuration: Windows XP
Safari 530.1

7 réponses

  1. Contributeur
    bonjour,
    difficille de te répondre sans voir le code...

    si dans ce code tu as des pointeurs comme set machin=blabla, set truc=azertyuio

    avant end sub, il faut libèrer ces pointeurs
    set machin=nothing

    si une partie de la procèdure qui à instancié ces pointeurs en a plus besoin dans le déroulement du proceesus global, il faut alors les libèrer le +tot possible
    0
    1. Merci je vais tester ça pour commencer.
      0
      1. Ca ne marche toujours pas, :'(
        Voici le code s'il vous plait :

        Dim serverConnection As Boolean
        Dim server As String
        Dim user As String
        Dim pwd As String
        Dim homeScript As String
        Dim perlHome As String
        
        '==========================================
        '==========================================
        
        'This function create a text file containing the list of
        'of sequence which have to be execute and excute them
        Function getSeqList()
        
         'Sequence List
         Dim seqName, fileName As String
         Dim firstSeqId As Long
         Dim treatmentDate As String
         Dim prmUserValue As String
         Dim dateSplit() As String
         Dim getKshFile As String
         Dim euTest As Boolean
         Dim naTest As Boolean
         
         '1 for NA test
         '3 for EU Test
         Dim typeTest As Byte
         typeTest = 3
         
         
         
         
         Worksheets("Jobs_or_Sequences_Name").Activate
         idEmptyLastLine = Application.CountA(Columns("A:A"))
         
         Set fs = CreateObject("Scripting.FileSystemObject")
         Set seqList = fs.CreateTextFile(ThisWorkbook.Path & "\sequenceList.txt", True)
          
          
           For firstSeqId = 2 To idEmptyLastLine
             seqName = Worksheets("Jobs_or_Sequences_Name").Cells(firstSeqId, 1).Value
             fileName = Worksheets("Jobs_or_Sequences_Name").Cells(firstSeqId, 2).Value
             param2 = Worksheets("Jobs_or_Sequences_Name").Cells(firstSeqId, 3).Value
             
             seqList.WriteLine (seqName & ";" & fileName & ";" & param2 & ";")
              
         Next
         seqList.Close
         
         'Connection info
         server = Worksheets("Connection_info").servername.Value
         user = Worksheets("Connection_info").username.Value
         pwd = Worksheets("Connection_info").password.Value
         homeScript = Worksheets("Connection_info").scriptHome.Value
         perlHome = Worksheets("Connection_info").perlHomeDir.Value
         
         'Environment
         envSelected = Worksheets("Jobs_or_Sequences_Name").listRelease.Value
        
          
         treatmentDate = Worksheets("Jobs_or_Sequences_Name").trtDate.Value
         prmUserValue = Worksheets("Jobs_or_Sequences_Name").prmUser.Value
         
         
         getKshFile = Worksheets("Jobs_or_Sequences_Name").onlyKsh.Value
          
         If getKshFile Then
                getKshFile = "1"
          Else
                getKshFile = "0"
          End If
          
         If treatmentDate Like "##/##/####" Then
         
                 dateSplit = Split(treatmentDate, "/")
                 treatmentDate = dateSplit(2) & "-" & dateSplit(1) & "-" & dateSplit(0)
               
                  
                'Get the selected environnement
                Set appExcel = CreateObject("Excel.Application")
                Set wbExcel = appExcel.Workbooks.Open(ThisWorkbook.Path & "\listEnvironnement.csv")
                Set wEnvlistEnvExcel = wbExcel.Worksheets(1)
                islastLine = False
                getEnv = False
                idEmptyLastLine = 2
                Do While (islastLine = False) And (getEnv = False)
                   envInfo = wEnvlistEnvExcel.Cells(idEmptyLastLine, 1).Value
                  
                   envInfoTab = Split(envInfo, ";")
                   
                   If Not (envInfo Like "") Then
                        currEnv = envInfoTab(0)
                        envFile = envInfoTab(1)
                   End If
                   
                   If currEnv Like envSelected Then
                      getEnv = True
                      
                   End If
                   If envInfo Like "" Then
                       islastLine = True
                   End If
                   idEmptyLastLine = idEmptyLastLine + 1
                   
                 Loop
                
                
                euTest = Worksheets("Jobs_or_Sequences_Name").EU_Test.Value
                naTest = Worksheets("Jobs_or_Sequences_Name").NA_Test.Value
                
                If euTest Then
                     typeTest = 3
                Else
                      typeTest = 1
                End If
                
                
                
              
                
                'Run the jobs on the selected environnement
                If getEnv Then
                     Shell (perlHome & "\bin\perl " & ThisWorkbook.Path & "\execAllSeqs.pl " & envFile & " " & server & " " & user & " " & pwd & " " & ThisWorkbook.Path & "\" & " " & treatmentDate & " " & prmUserValue & " " & homeScript & " " & getKshFile & " " & typeTest)
                Else
                      MsgBox "The release " & envSelected & " has not been defined, please retry"
                End If
                
            
           Else
                MsgBox "Incorrect date format, please retry with a date format like dd/mm/aaaa"
          End If
          
            
            
         End Function
        
        '==========================================
        '==========================================
        
        'This function verifies connections informations and set
        'values of servername, username, password, script home directory
        Function testConnection(servername, username, password, testAutoDir)
            
            Dim islastLine As Boolean
           islastLine = False
           Dim idEmptyLastLine As Integer
          
            perlHome = Worksheets("Connection_info").perlHomeDir.Value
            
            Shell (perlHome & "\bin\perl " & ThisWorkbook.Path & "\ping.pl " & servername & " " & username & " " & password & " " & testAutoDir & " " & ThisWorkbook.Path & "\")
            newHour = Hour(Now())
            newMinute = Minute(Now())
            newSecond = Second(Now()) + 10
            waitTime = TimeSerial(newHour, newMinute, newSecond)
            Application.Wait waitTime
            
            res = readFileContent(ThisWorkbook.Path & "\ping.csv", servername)
            
               
                 
            'Initialization of the environment list
            Set appExcel = CreateObject("Excel.Application")
            Set wbExcel = appExcel.Workbooks.Open(ThisWorkbook.Path & "\listEnvironnement.csv")
            Set wlistEnvExcel = wbExcel.Worksheets(1)
            islastLine = False
            idEmptyLastLine = 2
            Worksheets("Jobs_or_Sequences_Name").listRelease.Clear
            Do While islastLine = False
               envInfo = wlistEnvExcel.Cells(idEmptyLastLine, 1).Value
               envInfoTab = Split(envInfo, ";")
                      
               If Not (envInfo Like "") Then
                   currEnv = envInfoTab(0)
                   Worksheets("Jobs_or_Sequences_Name").listRelease.AddItem currEnv
               
               Else
                  islastLine = True
               End If
               idEmptyLastLine = idEmptyLastLine + 1
             Loop
            
             
            If res Then
                MsgBox "Successfully !"
                serverConnection = True
                server = servername
                user = username
                pwd = password
            End If
            
            
            
            'Delete temporary file
            Kill (ThisWorkbook.Path & "\ping.csv")
            
        End Function
        
        '==========================================
        '==========================================
        
        'Read the the result off the script ping.pl
        Function readFileContent(fileName, servername) As Boolean
         
            Dim appExcel As Excel.Application 'Application Excel
            Dim wbExcel As Excel.Workbook 'Classeur Excel
            Dim wsExcel As Excel.Worksheet 'Feuille Excel
            Dim res As Boolean
            res = False
            
                
            'Ouverture de l'application
            Set appExcel = CreateObject("Excel.Application")
            'Ouverture d'un fichier Excel
            Set wbExcel = appExcel.Workbooks.Open(fileName)
            'wsExcel correspond à la première feuille du fichier
            Set wsExcel = wbExcel.Worksheets(1)
            
            pingResult = wsExcel.Cells(1, 1).Value
            
            'Servername invalid
            If pingResult Like "2" Then
                  MsgBox "Cannot connect to the server " & servername
            End If
            
            'Username or password invalid
            If pingResult Like "4" Then
                 MsgBox "Invalid username or password"
            End If
            
            'Servername, username and password valid
            If pingResult Like "3" Then
                  res = True
            End If
             
            wbExcel.Close
            
            readFileContent = res
            
        End Function
        
        '==========================================
        '==========================================
         
        Function generateAllMOTL()
        
         Dim cubeListFileName As String
         Dim islastLine As Boolean
         islastLine = False
         
          
        
        'List of cube that we have to generate
            Worksheets("Cube_generation").Activate
            idEmptyLastLine = Application.CountA(Columns("A:A"))
         
            Set fs1 = CreateObject("Scripting.FileSystemObject")
            Set cubeList = fs1.CreateTextFile(ThisWorkbook.Path & "\cubeList.txt", True)
            cubeListFileName = ThisWorkbook.Path & "\cubeList.txt"
          
            For firstSeqId = 2 To idEmptyLastLine
              cubeName = Worksheets("Cube_generation").Cells(firstSeqId, 1).Value
              
              cubeList.WriteLine (cubeName & ";")
            
           Next
           
           cubeList.Close
           
           'Read the file cubeList.txt
           Set appExcelCube = CreateObject("Excel.Application")
           cubeListFileName = ThisWorkbook.Path & "\cubeList.txt"
           Set wbExcelCube = appExcelCube.Workbooks.Open(cubeListFileName)
           'wsExcel correspond à la première feuille du fichier
            Set wsbExcelCube = wbExcelCube.Worksheets(1)
        
            idEmptyLastLine = 1
            Do While (islastLine = False)
            
              cubeInfo = wsbExcelCube.Cells(idEmptyLastLine, 1).Value
              If Not (cubeInfo Like "") Then
               
                     cubeInfoTab = Split(cubeInfo, ";")
                     'MsgBox "Cube = " & cubeInfoTab(0)
                     generateMOTL (cubeInfoTab(0))
                    
               Else
                     islastLine = True
               End If
                     
               idEmptyLastLine = idEmptyLastLine + 1
               
            Loop
        
             wbExcelCube.Close
        
        End Function
        
        '==========================================
        '==========================================
        
        'Generate a cube related to a specfied motl
        Function generateMOTL(motlNameToFind)
        
            Dim islastLine, findOTL As Boolean
            islastLine = False
            findOTL = False
            Dim msgConf As Byte
            msgConf = 0
            
                
             Set appExcel = CreateObject("Excel.Application")
             
            'Search all the information related to 'motlName'
            fileName = ThisWorkbook.Path & "\listMOTL.csv"
            Set wbExcel = appExcel.Workbooks.Open(fileName)
            'wsExcel correspond à la première feuille du fichier
            Set wsbExcel = wbExcel.Worksheets(1)
               
            idEmptyLastLine = 2
            Do While ((islastLine = False) And (findOTL = False))
            
               appInfo = wsbExcel.Cells(idEmptyLastLine, 1).Value
               appInfoTab = Split(appInfo, ";")
                      
               If Not (appInfo Like "") Then
                   motlCurrent = appInfoTab(0)
              
                   If motlNameToFind = motlCurrent Then
                      findOTL = True
                      
                      cbsName = ThisWorkbook.Path & "\cbs\" & appInfoTab(1)
                      
                      
                       'msgConf = MsgBox("Do you really want to generate the motl " & motlNameToFind & " ? ", vbOKCancel)
                       'MsgBox "cmd.exe /K " & " " & ThisWorkbook.Path & "\loadEssAPP.bat " & " " & motlNameToFind & " " & cbsName
                      
                        Shell ("cmd.exe /K " & " " & ThisWorkbook.Path & "\loadEssAPP.bat " & " " & motlNameToFind & " " & cbsName)
                      
                      
                   End If
                   
               Else
                  islastLine = True
               End If
               idEmptyLastLine = idEmptyLastLine + 1
            
            Loop
            
           If Not findOTL Then
              MsgBox "The following motl " & motlNameToFind & " does not exist"
           End If
        
        End Function
        
        0
        1. Contributeur
          Re,

          tes fonctions ouvrent à chaque fois Excel ( tes 3 excel.exe dans le gestionnaire de tâches) pour affecter des valeurs (pingresult par ex) mais ne l referment pas excel
          peut-^tre ( mais je ne sais pas à quoi servent ces procédures) faudrait il quitter excel à la fin de chaque fonction
          (attention: beaucoup d'antivirus n'aiment pas beaucoup "Quit") peut-être en passant pas une série de set xxx=nothing dans l'ordre inverse de leur intancation...
          je ne peux guère t'en dire plus.
          0
          1. Est ce que ça ne viendrait pas de la ligne :

            Set appExcel = CreateObject("Excel.Application")

            Qu'en pensez-vous SVP? Est-ce que j'aurais oublié un truc par rapport à cette ligne?
            0
        2. bonjour,

          en début de la fonction il y a.....

          Set appExcel = CreateObject("Excel.Application")

          'Search all the information related to 'motlName'
          fileName = ThisWorkbook.Path & "\listMOTL.csv"
          Set wbExcel = appExcel.Workbooks.Open(fileName)
          'wsExcel correspond à la première feuille du fichier
          Set wsbExcel = wbExcel.Worksheets(1)

          il faut donc en fin de fonction ajouter

          set appExcel.quit ' on ferme l'application excel.
          Set appExcel = nothing ' ce processus libère l'objet en mémoire : la référence

          bien sur chaque fois qu'il y a un "set" il faut un "nothing".
          0
          1. Contributeur
            Salut Bidoullieu,

            Il me semblait bien lui avoir dit, mais il a l'air de ne pas vouloir comprendre

            Enfin, mieux vaut 2 fois qu'une :-) (ou la stéréo...)
            0
          2. @michel_mMerci Bidoullieu et michel_m,

            Michel_m, je n'avais pas du bien comprendre ton message, car je suis nouveau dans le monde du dév sous Excel (et ailleurs) donc je n'ai surement pas bien du comprendre ;-) Excuse-moi si c'est ce que tu voulais dire.

            Merci à vous en tout cas, je vais tester demain!
            0
        3. Contributeur
          Bonjour à tous,
          Une petite précision, en principe tout les objets que tu crée avec Set .... doivent êtres libéré le plus tôt possible (avec set .. = Nothing) et au pire avant de quitter la procédure.
          Parce que non seulement tu crée à chaque fois l'application excel mais tu crée également des classeurs.
          A+
          0
          1. Bonjour,

            ce que j'apprécie chez vous.... c'est votre humour .... ou vos coup de G.....
            tout en donnant l'information ou la marche suivre pour ne pas trébucher bien sur ...
            Bonne journée à tous.
            0
            1. Contributeur
              Excuse Bidouilleu_R, je n'avais pas lu ta petite ligne en dessous de tes lignes en gras. :X
              0
            2. @lermite222Aucun soucis pour moi comme dis michel_M vaut mieux la stéréo....
              A+
              0