vérifier la fin d'ouverture d'un programme externe

XL_Luc · 2 Juin 2008

Bonjour à tous,

Voici ma première question alors à vos claviers 🙂
C'est un problème qui me prend la tête depuis 2 ans et j'avais même pas eu l'idée de venir sur un forum pas bien malin le Luc.

Bon passons aux choses sérieuses,

J'ai fait un "robot" qui ouvre une application externe (logiciel propriétaire) et ensuite envoi des informations par un sendkeys.

J'arrive à activer l'application sans difficulté et une fois celle ci ouverte à gérer les flux avec le "NUMLOCK" ce programme ayant la spécificité de d'étaeinde le numlock lorsqu'il est en attente.

Voilà maintenant le problème, avec shell(chemin_du_programme), je ne sais pas quand le logiciel est prêt à recevoir les touches.
J'ai contourné le problème avec un timer qui attend 15s ou plus (selon un paramètre) mais cette solution n'est pas satisfaisante.
Soit le logiciel se lance en 3s et on attend pour rien, soit le serveur est chargé, il met plus que 15s et là tout plante ça fait moche et surtout ça entraine n'importe quoi après.

Donc comment savoir que le programme est prêt à recevoir les données, sachant que je peux tester le nom de sa fenêtre mais je n'y arrive pas.

voici à toutes fins utiles mon code mais malheureusement, il n'est pas testable

Code:

Option Private Module
Option Explicit
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VK_NUMLOCK = &H90
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2

Dim task As String

Private Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type

' declarations API

Private Declare Function GetVersionEx Lib "kernel32" _
   Alias "GetVersionExA" _
   (lpVersionInformation As OSVERSIONINFO) As Long

Private Declare Sub keybd_event Lib "user32" _
   (ByVal bVk As Byte, _
    ByVal bScan As Byte, _
    ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    
Private Declare Function GetKeyboardState Lib "user32" _
   (pbKeyState As Byte) As Long

Private Declare Function SetKeyboardState Lib "user32" _
   (lppbKeyState As Byte) As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Sub lancer_saga_t54()
Dim x, i
Dim compte, annee, moi

definition_variables
param_T54.an.Text = Right(param.Cells(1, 2), 2)
param_T54.moi.Text = Month(param.Cells(2, 2))
param_T54.cpte.Text = (Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4))
param_T54.Show

If param_T54.an.Text = "" Then Exit Sub
If Not (IsNumeric(param_T54.an.Value)) Then
x = MsgBox("Année : format sur 2 chiffres", vbCritical, "erreur parametres")
Exit Sub
End If

If (param_T54.moi.Value < 1 Or param_T54.moi.Value > 12) And param_T54.moi.Value <> "" Then
x = MsgBox("Le mois n'est pas valide", vbCritical, "erreur parametres")
Exit Sub
End If


compte = param_T54.cpte.Text
annee = param_T54.an.Text
moi = param_T54.moi.Text
i = dern_ligne

journalise "T54 automatique", "Compte : " & compte & " mois : " & moi

deprotege

lance_saga_permanant

SendKeys "T54{ENTER}", True
'Application.Wait (Now + TimeValue("0:0:2"))

attend_reponse



SendKeys "00", True
SendKeys annee, True
SendKeys compte, True
SendKeys "{ENTER}", True
attend_reponse


'début de la boucle de copie
Do

    SendKeys "%e t{ENTER}", True
 attend_reponse
   
        Cells(i, 1).Select
        ActiveSheet.Paste
        
'vérification fin traitement
If Not (Cells(i + 23, 1) Like "DETAIL LIGNE*") Then
Exit Do
End If

If CDbl(Mid(Cells(i + 5, 1), 13, 2)) < moi And moi <> "" Then
'le mois est dépassé on a  tourné assez de pages
Exit Do
End If



If CDbl(Mid(Cells(i + 5, 1), 13, 2)) = moi Or moi = "" Then
'le mois est ok

Range(Cells(i, 1), Cells(i + 27, 1)).Select
T54
i = ActiveCell.Row
End If
      
    
  SendKeys "{ENTER}", True
attend_reponse

Loop
 Selection.ClearContents
 'fermeture sage
 ferme_saga

Cells(4, 1).Select
protege
End Sub

Public Function NumLockOn() As Boolean
    Dim iKeyState As Integer
    iKeyState = GetKeyState(vbKeyNumlock)
    NumLockOn = (iKeyState = 1 Or iKeyState = -127)
    
End Function

Public Sub ToggleNumLock(TurnOn As Boolean)

    'true pour allumer
    'false pour eteindre
    
      Dim bytKeys(255) As Byte
      Dim bnumLockOn As Boolean
      
'Get status of the 256 virtual keys
      GetKeyboardState bytKeys(0)
      
      bnumLockOn = bytKeys(VK_NUMLOCK)
      Dim typOS As OSVERSIONINFO
      
      If bnumLockOn <> TurnOn Then 'if current state <>
                                     'requested stae
        
       If typOS.dwPlatformId = _
           VER_PLATFORM_WIN32_WINDOWS Then  '=== Win95/98

          bytKeys(VK_NUMLOCK) = 1
          SetKeyboardState bytKeys(0)

        Else    '=== WinNT/2000

        'Simulate Key Press
          keybd_event VK_NUMLOCK, &H45, _
             KEYEVENTF_EXTENDEDKEY Or 0, 0
        'Simulate Key Release
          keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY _
             Or KEYEVENTF_KEYUP, 0
        End If
      End If
     
End Sub



Sub lance_saga_permanant()
ToggleNumLock (True)
task = Shell(saga_permanant)

Application.Wait (Now + param.Cells(13, 2))
'AppActivate task, True
End Sub

Sub ferme_saga()
'fermeture puis ouverture pour regler le probleme du verr num

SendKeys "%{F4}", True
 SendKeys "{ENTER}"
 Application.Wait (Now + TimeValue("0:0:2"))

task = Shell(saga_permanant)

Application.Wait (Now + param.Cells(13, 2))
'AppActivate task, True

SendKeys "T54{ENTER}", True
Application.Wait (Now + TimeValue("0:0:2"))

 SendKeys "^{F11}%Q", True
 ToggleNumLock (True)



End Sub

Sub attend_reponse()
While Not NumLockOn
Wend
End Sub

wilfried_42 · 2 Juin 2008

Re : vérifier la fin d'ouverture d'un programme externe

Bonjour Luc

Question : le programme recoit des données ok mais qu'en fait il ?

cree t'il un fichier ? ou des son lancement peut il en creer un ?
si oui, l'existance de ce fichier peut declancher la suite du traitement ....

XL_Luc · 2 Juin 2008

Re : vérifier la fin d'ouverture d'un programme externe

Et non pas de fichier, je récupère les données par une action qui produit "copier tout l'écran" que je colle ensuite dans Excel pour traitement.

Compte Supprimé 979 · 2 Juin 2008

Re : vérifier la fin d'ouverture d'un programme externe

Salut XL_Luc,

Essaye avec ce code trouvé sur le site de l'ami Ce site n'existe plus

Code:

'lancer une application et attendre sa fin pour continuer
Private Declare Function OpenProcess Lib "kernel32" _
        (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
        ByVal dwProcessId As Long) As Long
 
Private Declare Function GetExitCodeProcess Lib "kernel32" _
        (ByVal hProcess As Long, lpExitCode As Long) As Long
 
Sub test()
  MsgBox RunProcess
End Sub
 
Function RunProcess() As Long
' Jeff McAhren, mpep
' Requires two module level API function declarations be present
' Returns elapsed time of process as long integer, or -1 if process fails
 
    Dim TaskID As Long
    Dim hProc As Long
    Dim lExitCode As Long
    Dim ACCESS_TYPE
    Dim STILL_ACTIVE
    Dim StartTime As Date
 
    ACCESS_TYPE = &H400
    STILL_ACTIVE = &H103
 
    On Error GoTo RunProcessError
 
    StartTime = Now
    TaskID = Shell("freecell", 1)
 
    'Get the process handle
    hProc = OpenProcess(ACCESS_TYPE, False, TaskID)
 
    Do
        GetExitCodeProcess hProc, lExitCode
        DoEvents
    Loop While lExitCode = STILL_ACTIVE
 
    RunProcess = DateDiff("s", StartTime, Now)
    Exit Function
 
RunProcessError:
    RunProcess = -1
End Function

Par contre je ne sais pas ou et comment le placer dans ton code 😉

A toi de voir

Edit : Salut Wilfried42 🙂

XL_Luc · 2 Juin 2008

Re : vérifier la fin d'ouverture d'un programme externe

mais ça me parait pas mal du tout.
Je ne peux malheureusement pas tester ce soir car je suis chez moi et la méthode d'accès au disque "G" est différente.

Dès demain matin je test ça et je vous donne des nouvelles mais à priori ça me parait possible après analyse du code même si des envois au kernel32 c'est la limite de mes compétences Excel, je suis pas informaticien 😀

wilfried_42 · 2 Juin 2008

Re : vérifier la fin d'ouverture d'un programme externe

re:

uniquement pour saluer Bruno 🙂 (Belle trouvaille)

XL_Luc · 2 Juin 2008

Re : vérifier la fin d'ouverture d'un programme externe

Bon j'ai réfléchi (si si ça m'arrive) en fait ça ne marchera pas.
Bon j'explique, le programme en lui même se lance très vite mais fait appel ensuite ua serveur pour être vraiment actif.
Il "dira" donc qu'il est lancé même s'il n'est pas prêt.

Je pense que le seul moyen est de tester le nom de la fenêtre qui elle change quand il est "prêt".

Allez les pros, j'ai besoin de vous 😱

XL_Luc · 3 Juin 2008

Re : vérifier la fin d'ouverture d'un programme externe

Et non ça ne fonctionne pas.
La macro proposée lance un programme externe et attend qu'il soit fermé pour continuer.

A l'aide !!!!!! 😕😕

wilfried_42 · 3 Juin 2008

Re : vérifier la fin d'ouverture d'un programme externe

Re:

Completement aleatoire, mais comme il n'y a pas de fichier, pas de retour (de connection) de la part du logiciel

un essai à faire : gerer l'occupation de la memoire
à un moment tu as une occupation de memoire X, puis Y et enfin Z

logiquement, au lancement du logiciel, Quelque soit X, Z-X doit etre toujours de meme taille

regarde Cette API

MJ13 · 3 Juin 2008

Re : vérifier la fin d'ouverture d'un programme externe

Bonjour à tous.

Et pourquoi ne pas fermer l'application avant de commencer par un kill process?

XL_Luc · 3 Juin 2008

Re : vérifier la fin d'ouverture d'un programme externe

Merci à tous pour votre aide, j'ai "presque" réussi mais j'aimerai améliorer la macro.

En fait je viens d'y penser, je

- vide le presse papier
- lance le programme
- lance "sans cesse" un sendkeys CTRL+C
- je colle dans une cellule
- si erreur -> rien n'est copier, je boucle
- si pas d'erreur le programme est prêt à recevoir

voilà mon code :

Code:

Sub lance_saga_permanant()


ToggleNumLock (True)
task = Shell(saga_permanant, 3)
DoEvents
' vide le presse papier
Cells(1, 1).ClearContents
Cells(1, 1).Copy
Application.CutCopyMode = False

i = 1
On Error Resume Next

Do
SendKeys "^C"
DoEvents
Cells(1, 1).Select
ActiveSheet.Paste
Loop Until Cells(1, 1) <> ""
DoEvents

End Sub

maintenant j'aimerai vider le presse papier plus "proprement" je n'y arrive pas avec les fonctions GetFromClipboard et PutInClipboard.
J'aimerai en fait mettre un objet "Null" dans le presse papier et tester celui ci jusuq'à avoir un objet non nul (car mon CTRL+C" a fonctionné.

Merci d'encore m'aider 🙂

XL_Luc · 3 Juin 2008

Re : vérifier la fin d'ouverture d'un programme externe

La problématique n'étant plus la même, j'ouvre un autre fil.

Merci à tous

Effectuez une recherche sur Excel Downloads...

vérifier la fin d'ouverture d'un programme externe

XL_Luc

XLDnaute Occasionnel

wilfried_42

XLDnaute Barbatruc

XL_Luc

XLDnaute Occasionnel

Compte Supprimé 979

Guest

XL_Luc

XLDnaute Occasionnel

wilfried_42

XLDnaute Barbatruc

XL_Luc

XLDnaute Occasionnel

XL_Luc

XLDnaute Occasionnel

wilfried_42

XLDnaute Barbatruc

MJ13

XLDnaute Barbatruc

XL_Luc

XLDnaute Occasionnel

XL_Luc

XLDnaute Occasionnel

Discussions similaires

Nous accordons de l'importance à votre vie privée