-
Oct 12th, 2020, 10:08 AM
#1
Thread Starter
New Member
VBA Macro gets slower with every execution
I have a macro that reads (once per minute) last line of a .txt file to store in a string variable It close .txt file. It Check if there is a jpg file witch finish with last line to display it on VLC… Then close VLC after 1 minutes
Problem:
-macro gets slower with every execution.
-Exel take more RAM with every execution take 29.9Mo on start.
Take more than 100Mo after 24 hours
I know a partial solution is to close and reopen the .xlsm file manually relaunch again. However, some time it take too many time to close and Have to force restart PC.
What I'm asking is if there is another way to solve this, what I believe is to be a memory clearing issue?
I have tried to
1) Clear the Undo buffer (ActiveDocument.UndoClear) but it make an compilation error
2) Save the document periodically. Unfortunaly it is read only for the panel PC => error
How can I periodically clean the RAM usage?
thanks. and Cheers
My code:
This workbook:
Code:
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTempo
End Sub
Private Sub Workbook_Open()
Userform1.Show
End Sub
Module1
Code:
Option Explicit
Dim Tps As Date
Public cyclesPPT As Integer
Public cptAffichage As Integer
Dim RetVal As Long
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, _
lpdwprocessid As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Const WM_CLOSE = &H10
Private Const GWL_STYLE = (-16)
Private Const WS_SYSMENU = &H80000
Private Function CloseWindow(ByVal hwnd As Long, ByVal hInstance As Long) As Long
Dim idproc As Long
idproc = 0
'reçoit dans idproc l'id du processus lié à cette fenêtre
GetWindowThreadProcessId hwnd, idproc
If (idproc = hInstance) And ((GetWindowLong(hwnd, GWL_STYLE) And WS_SYSMENU) = WS_SYSMENU) Then
PostMessage hwnd, WM_CLOSE, 0, 0
End If
'obligatoire pour qu'EnumWindows continue l'énumération
CloseWindow = True
End Function
Public Sub KillApp(hInstance As Long)
EnumWindows AddressOf CloseWindow, hInstance
End Sub
Public Function KillProcess(ByVal ProcessName As String) As Boolean
Dim svc As Object
Dim sQuery As String
Dim oproc
Set svc = GetObject("winmgmts:root\cimv2")
sQuery = "select * from win32_process where name='" & ProcessName & "'"
For Each oproc In svc.execquery(sQuery)
oproc.Terminate
Next
Set svc = Nothing
End Function
Public Function FichierExiste(MonFichier As String)
'par Excel-Malin.com ( https://excel-malin.com )
If MonFichier <> "" And Len(Dir(MonFichier)) > 0 Then
FichierExiste = True
Else
FichierExiste = False
End If
End Function
Sub Tempo()
Application.DisplayAlerts = False
Dim i As Integer
Dim j As Integer
'Programmation de l'évènement toutes les 1 minutes
Tps = Now + TimeValue("00:01:00")
KillProcess "vlc.exe"
Application.OnTime Tps, "Tempo"
On Error GoTo Fin
Workbooks.Open Filename:="A:\Etuve.csv", ReadOnly:=True, local:=True
'Workbooks.Open Filename:="S:\Peinture\Etuve.csv", ReadOnly:=True, local:=True
Dim Ligneencours As Double
Dim Référenceencours As Integer
Ligneencours = Range("A65536").End(xlUp).Row
'décallage = Nb ponts sur balancelle (R1) + nb ponts au déchargement (6)
Ligneencours = Ligneencours - 62
'gestion des balancelles vides
While Cells(Ligneencours, 11) = "0"
Ligneencours = Ligneencours + 1
Wend
Référenceencours = Cells(Ligneencours, 11).Value
'déclarer le bon numéro
Workbooks("Ouvrir fiche expedition v4-1.xlsm").Activate
Userform1.TEXTE1.Text = Référenceencours
Workbooks("Etuve.csv").Activate
ActiveWorkbook.Close False
Call OUVRIR_PPT
'ThisWorkbook.Save (disable because error on ro file
Application.DisplayAlerts = True
Exit Sub
'fin alternative en cas d'erreur
Fin:
On Error GoTo -1
Application.DisplayAlerts = True
End Sub
Sub StopTempo()
On Error Resume Next
'Stopper la gestion de l'évènement OnTime en cours
Application.OnTime Tps, "Tempo", , False
End Sub
Sub OUVRIR_PPT()
cyclesPPT = cyclesPPT + 1
cptAffichage = cptAffichage + 1
Dim i As Integer
Dim Chemin As String
On Error GoTo Fin
'trouver diapo CONDITIONNEMENT
If cptAffichage < 6 Then
Dim Chemin2 As String, Fichier As String
'Définit le répertoire contenant les fichiers
Chemin2 = "O:\FONDFABR\FONDEXPE\MODE_OPERATOIRE_EXPE\conditionnementv2\"
'Boucle sur tous les fichiers jpg du répertoire.
Fichier = Dir(Chemin2 & "*" & Userform1.TEXTE1.Text & ".jpg")
'Utilisez la syntaxe suivante pour boucler sur tous les types de fichiers :
'Fichier = Dir(Chemin & "*.*")
If Len(Fichier) > 0 Then
Chemin = Chemin2 & Fichier
Else
Userform1.TEXTE1.Text = "pa-trouvé"
Chemin = "O:\FONDFABR\FONDEXPE\MODE_OPERATOIRE_EXPE\conditionnementv2\NoImage.jpg"
End If
If FichierExiste(Chemin) = True Then
'c bon'
Else
Userform1.TEXTE1.Text = "pa-trouvé"
Chemin = "O:\FONDFABR\FONDEXPE\MODE_OPERATOIRE_EXPE\conditionnementv2\NoImage.jpg"
cyclesPPT = 0
End If
End If
'Ouvrir fiche qualité
If cptAffichage > 5 Then
'Définit le répertoire contenant les fichiers
Chemin2 = "O:\FONDFABR\FONDEXPE\MODE_OPERATOIRE_EXPE\conditionnementv2\Qualité\"
'Boucle sur tous les fichiers jpg du répertoire.
Fichier = Dir(Chemin2 & "*" & Userform1.TEXTE1.Text & ".png")
'Utilisez la syntaxe suivante pour boucler sur tous les types de fichiers :
'Fichier = Dir(Chemin & "*.*")
If Len(Fichier) > 0 Then
Chemin = Chemin2 & Fichier
Else
Userform1.TEXTE1.Text = "pa-trouvé"
Chemin = "O:\FONDFABR\FONDEXPE\MODE_OPERATOIRE_EXPE\conditionnementv2\Qualité\NoImage.jpg"
End If
If FichierExiste(Chemin) = True Then
'c bon'
Else
Userform1.TEXTE1.Text = "pa-trouvé"
Chemin = "O:\FONDFABR\FONDEXPE\MODE_OPERATOIRE_EXPE\conditionnementv2\Qualité\NoImage.jpg"
cyclesPPT = 0
cptAffichage = 0
'ActiveDocument.UndoClear fonctionne pas
End If
End If
'Rien a signaler qualité (mode auto)
Chemin2 = "O:\FONDFABR\FONDEXPE\MODE_OPERATOIRE_EXPE\conditionnementv2\Qualité\"
Fichier = Dir(Chemin2 & "*" & Userform1.TEXTE1.Text & ".png")
'Utilisez la syntaxe suivante pour boucler sur tous les types de fichiers :
'Fichier = Dir(Chemin & "*.*")
If Len(Fichier) = 0 Then
cptAffichage = 3
End If
If cptAffichage > 10 Then
cptAffichage = 0
End If
'MsgBox (Chemin)
'consigne ne pas passer sous une charge
If cyclesPPT > 23 Then
Chemin = "O:\FONDFABR\FONDEXPE\MODE_OPERATOIRE_EXPE\Chargement\sous-charge.jpg"
End If
If cyclesPPT > 25 Then
cyclesPPT = 0
'ActiveDocument.UndoClear (disable because doesn't work: error compilation unknow variable)
End If
RetVal = Shell("C:\Program Files (x86)\VideoLAN\VLC\vlc.exe " & Chemin, vbMaximizedFocus = True)
RetVal = Shell("C:\Program Files (x86)\VideoLAN\VLC\vlc.exe " & Chemin, vbMaximizedFocus = True)
RetVal = Shell("C:\Program Files (x86)\VideoLAN\VLC\vlc.exe " & Chemin, vbMaximizedFocus = True)
RetVal = Shell("C:\Program Files (x86)\VideoLAN\VLC\vlc.exe " & Chemin, vbMaximizedFocus = True)
RetVal = Shell("C:\Program Files (x86)\VideoLAN\VLC\vlc.exe " & Chemin, vbMaximizedFocus = True)
RetVal = Shell("C:\Program Files (x86)\VideoLAN\VLC\vlc.exe " & Chemin, vbMaximizedFocus = True)
Fin:
On Error GoTo -1
End Sub
-
Jun 16th, 2021, 05:22 AM
#2
Thread Starter
New Member
Re: VBA Macro gets slower with every execution
Hi,
I have no nexs and the problem still occure
VBA is alw&ays taking more and more ram and crash
after 12 hours It take 224Mo instead of 30Mo ant crash
How to free ram without restart excel?
what is the syntax?
-
Jun 16th, 2021, 06:14 AM
#3
Re: VBA Macro gets slower with every execution
I have a macro that reads (once per minute) last line of a .txt file
how are you firing the one minute event?
i would avoid (find an alternative to) all lines that select, activate or use any selection or active anything
does it really require a userform for this operation? are there any controls on the form that require references?
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Jun 16th, 2021, 10:38 AM
#4
Thread Starter
New Member
Re: VBA Macro gets slower with every execution
Hi
to enable the one minutes event I do
Code:
'Programmation de l'évènement toutes les 1 minutes
Tps = Now + TimeValue("00:01:00")
To disable it I do
Code:
Sub StopTempo()
On Error Resume Next
'Stopper la gestion de l'évènement OnTime en cours
Application.OnTime Tps, "Tempo", , False
End Sub
and add on 'ThisWorkbook'
Code:
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTempo
End Sub
I need userform to stop tempo and load manualy some presentation ( to check if it is updated and what to focus in our process) this is done by every laborer, ( even those who have never use Office)
Unfortunally I have found no alternative to all lines that select, activate or use any selection or active anything. and everybody said me that ActiveDocument.UndoClear Or ThisWorkbook.Save should purge every undo story without any exception but ActiveDocument.UndoClear work only with Word
ThisWorkbook.Save doesn't work on Read only file
How can I manage to free RAM... with VBA for Excel please?
Last edited by benjibasson83; Jun 17th, 2021 at 12:51 AM.
-
Jun 17th, 2021, 04:27 AM
#5
Re: VBA Macro gets slower with every execution
How can I manage to free RAM... with VBA for Excel please?
by not filling it first is the best method
personally i would change from using application.ontime, change to an API timer
Unfortunally I have found no alternative to all lines that select, activate
simplest example
Workbooks("Etuve.csv").Activate
ActiveWorkbook.Close False
Code:
Workbooks("Etuve.csv").Close False
actions and editing to worksheets done from excel vba do not add to the undo list and can not be undone from excel
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Jun 17th, 2021, 08:13 AM
#6
Thread Starter
New Member
Re: VBA Macro gets slower with every execution
Originally Posted by westconn1
by not filling it first is the best method
personally i would change from using application.ontime, change to an API timer
simplest example
Code:
Workbooks("Etuve.csv").Close False
actions and editing to worksheets done from excel vba do not add to the undo list and can not be undone from excel
Hi, if I change to an API timer, I cannot use userform because it will not respond at all. Worst: I cannot close excel by the red cross. the unic way to stop an running API timer is to do ctrl alt supp => task manager => force close
=> this is impossible because no keyboard on our production line
I don't understand I have read the macro and I have seen zero line witch fill, refill refill to expense to 200Mo
For me using application.ontime everwrite do fill only on first round. =30 Mo total excel... on 2nd round it should stay again 30Mo and on a million round should be still 30Mo
Same for lines that select, activate or use any selection or active anything: it should fill ram once and basta.
What is fill refill refilling to reach 200Mo?
if you look at the sub tempo there is
Code:
Workbooks("inf.txt").Activate
ActiveWorkbook.Close False
More over
Code:
KillProcess "vlc.exe"
Thus in automatic mode,
-each time it open a file it close it properly
-Each time it open external application it close it properly...
is there a way to put a spy witch give me what fill ram
to have instructions to unfill ram taken by Microsoft Excel - unic-file.xlsm - Excel
-
Jun 18th, 2021, 01:41 AM
#7
Thread Starter
New Member
Re: VBA Macro gets slower with every execution
For me, nothing at all justify this
after only 2880 cycles VBA still fill extra ram althought there is no new dim variables at all
althought
Code:
Sub StopTempo()
On Error Resume Next
'Stopper la gestion de l'évènement OnTime en cours
Application.OnTime Tps, "Tempo", , False
End Sub
have never been call during these 48 last hours
althought no change has been done on Ouvrir Vidéo Supérieur.xlsm
altought all lines that select, activate or use any selection or active anything shouldn't fill extra, refill refill without free ram... it should only fill only once ram during the start of macro
-
Jul 7th, 2021, 02:28 AM
#8
Thread Starter
New Member
Re: VBA Macro gets slower with every execution
Hi,
I still have no solution:
1) why excell stil fill fill fill fill 220 Mo of ram for no ground at all without cleaning althought there is only one instance ( booth file.txt and external applications are closed properly)
2) How to clean ram without any human intervention at all? ( without stop vba neither excell)
thanks
Code:
Sub Tempo()
Dim i As Integer
Dim j As Integer
Dim Chemin As String
Dim FicheQual As Integer
Dim RetVal As Long
'Programmation de l'évènement toutes les 2 minutes 00
Tps = Now + TimeValue("00:02:00")
Application.OnTime Tps, "Tempo"
Application.DisplayAlerts = False
On Error GoTo FinErreur
Userform1.Label1.Caption = Now()
KillProcess "vlc.exe"
Range("A1").Copy Range("A1") 'this should delete undo story
Workbooks.Open Filename:="P:\inf.txt", ReadOnly:=True, local:=True
'Workbooks.Open Filename:="Y:\inf.txt", ReadOnly:=True, local:=True
Dim Ligneencours As Integer
Dim Référenceencours As Integer
Ligneencours = Range("A65536").End(xlUp).Row
If Cells(3, 1).Value = "" Then
Workbooks("inf.txt").Activate
ActiveWorkbook.Close False
Application.DisplayAlerts = True
Exit Sub
End If
While Cells(Ligneencours, 1) <> ""
Ligneencours = Ligneencours + 1
Wend
Référenceencours = Cells(Ligneencours - 1, 1).Value
'faire le lien entre numéro de plaque modèle et numéro de référence
Workbooks("Ouvrir vidéo Manchon.xlsm").Activate
For i = 2 To 300 Step 1
If Cells(i, 7).Value = Référenceencours Then
If Cells(i, 4).Value <> "pas de vidéo" Then
Userform1.TEXTE1.Text = Cells(i, 2).Value
Chemin = Feuil1.Range("C" & i).Value
Else
Userform1.TEXTE1.Text = 9999
Chemin = "O:\FONDFABR\FONDMOUL\MODE_OPERATOIRE_L17\REMMOULAGE_INFERIEUR\NoVidéo.mp4"
End If
End If
Next
Workbooks("inf.txt").Activate
ActiveWorkbook.Close False
'Chargement vidéo par VLC en auto
'KillApp (RetVal)'déplacement de la ligne
cyclesVLC = cyclesVLC + 1
'consigne ne pas passer sous une charge
If cyclesVLC > 25 Then
Chemin = "O:\FONDFABR\FONDMOUL\MODE_OPERATOIRE_L17\PROJET_VIDEO\fiches-secu\Mou-cable-manchons.jpg"
End If
If cyclesVLC > 26 Then
cyclesVLC = 0
End If
RetVal = Shell("C:\Program Files (x86)\VideoLAN\VLC\vlc.exe " & Chemin, vbMaximizedFocus = True)
'Ouverture fiche qualité
'faire le lien entre numéro de plaque modèle et numéro de référence
Workbooks("Ouvrir vidéo Manchon.xlsm").Activate
For i = 2 To 300 Step 1
If Cells(i, 7).Value = Référenceencours Then
If Cells(i, 6).Value <> "Pas de fiche" Then
FicheQual = 1
Chemin = Feuil1.Range("E" & i).Value
Else
FicheQual = 0
End If
End If
Next
'Chargement Fiche par firefox en auto si présence fiche. sinon chargement vidéo
If FicheQual = 1 Then
RetVal = Shell("C:\Program Files (x86)\VideoLAN\VLC\vlc.exe " & Chemin, vbMaximizedFocus = True)
RetVal = Shell("C:\Program Files (x86)\VideoLAN\VLC\vlc.exe " & Chemin, vbMaximizedFocus = True)
RetVal = Shell("C:\Program Files (x86)\VideoLAN\VLC\vlc.exe " & Chemin, vbMaximizedFocus = True)
RetVal = Shell("C:\Program Files (x86)\VideoLAN\VLC\vlc.exe " & Chemin, vbMaximizedFocus = True)
RetVal = Shell("C:\Program Files (x86)\VideoLAN\VLC\vlc.exe " & Chemin, vbMaximizedFocus = True)
End If
Application.DisplayAlerts = True
FinErreur:
Application.DisplayAlerts = True
On Error GoTo -1
End Sub
-
Aug 3rd, 2021, 05:56 PM
#9
Fanatic Member
Re: VBA Macro gets slower with every execution
Office is far from perfect, in fact the more you use it the more problems you find with it. workarounds are generally the way to go in these cases.
I recommend setting up something that just closes and reopens the file since you said that seems to work.
something very basic would be open the file again in a new excel app, close the current one. do that every hour or so.
Yes!!!
Working from home is so much better than working in an office...
Nothing can beat the combined stress of getting your work done on time whilst
1. one toddler keeps pressing your AVR's power button
2. one baby keeps crying for milk
3. one child keeps running in and out of the house screaming and shouting
4. one wife keeps nagging you to stop playing on the pc and do some real work.. house chores
5. working at 1 O'clock in the morning because nobody is awake at that time
6. being grossly underpaid for all your hard work
-
Nov 19th, 2021, 05:32 AM
#10
Thread Starter
New Member
Re: VBA Macro gets slower with every execution
Originally Posted by GBeats
Office is far from perfect, in fact the more you use it the more problems you find with it. workarounds are generally the way to go in these cases.
I recommend setting up something that just closes and reopens the file since you said that seems to work.
something very basic would be open the file again in a new excel app, close the current one. do that every hour or so.
Hi I confirme I albready set up something that just closes and reopens the file. On each cycle thus every two minutes
I let you notice that there is only one unic instance of Excell by looking on this task manager screenshot. and I still not understand what is going wrong with this file to fill 200 MiO more extra in RAM
because there is
1) No variable table
2) No more detail about what exactly are there explicit amoun this 218 Mio taken in ram. How to clean it? how to delete theses temps useless files witch are stored in RAM while at first hours it take only 30-40Mio in RAM
3) Every Workbooks.Open are followed with ActiveWorkbook.Close witch work properly
Last edited by benjibasson83; Nov 19th, 2021 at 05:38 AM.
-
Nov 19th, 2021, 06:41 AM
#11
Re: VBA Macro gets slower with every execution
if you want to post a workbook with the code and some sample data /workbook files i can try to see if the same problem exists here and if i can find a solution, but it might take a while as i only have limited time, though as testing can run mainly unattended it might not make any difference
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
Tags for this Thread
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|