Sujet Précédent Sujet Suivant

Fermer une application ouverte avec shell

cs_kouki69 Messages postés 95 Date d'inscription lundi 27 mars 2006 Statut Membre Dernière intervention 28 août 2015 - 14 sept. 2009 à 17:16
bubu60 Messages postés 7 Date d'inscription vendredi 18 juillet 2003 Statut Membre Dernière intervention 25 septembre 2009 - 25 sept. 2009 à 11:03
Salut,
Je n'ai rien trouvé sur le site qui réponds à ma question, pourtant, je pense que c'est quelque chose qui a dû circuler sur ce site, bref...
Voilà, je lance une application via VBA (programme de calculs qui utilise des données créées sous excel)
Mais une fois le calcul fait, je dois fermer l'application mais je ne vois pas comment. Y-a t-il une façon simple de quitter une application lancer via shell ??


Dim MyAppPFX, ReturnValue

MyAppPFX = Shell("C:\NET\FX5\RUN\FXWIN.EXE")...
Merci de partager votre savoir
A bientôt

13 réponses

Réponse 1 / 13
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 47
14 sept. 2009 à 18:10
salut, 

Private Const WM_CLOSE      As Long = &H10 
Private Const HTCAPTION     As Long = 2& 
Private Const GW_HWNDNEXT As Long = 2&
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As  Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib  "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As  Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As  Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 

Dim hPidAppPFX as long

private sub FxRun()
hPidAppPFX = Shell("C:\NET\FX5\RUN\FXWIN.EXE")
end sub

private sub FxStop()
Call SendMessage(InstanceToWnd(hPidAppPFX), WM_CLOSE, HTCAPTION, ByVal 0&) 
end sub

'http://www.codyx.org/snippet_recuperer-hwnd-handle-partir-pid-process-id_451.aspx#1462
private Function InstanceToWnd(ByVal target_pid As Long) As Long 'API-Guid
    Dim test_hwnd As Long, test_pid As Long, test_thread_id As  Long
    test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
    Do While test_hwnd <> 0&
        If GetParent(test_hwnd) = 0& Then
            test_thread_id = GetWindowThreadProcessId(test_hwnd,  test_pid)
            If test_pid = target_pid Then
                InstanceToWnd = test_hwnd
                Exit Do
            End If
        End If
        test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
    Loop
End Function


++

[hr]
0
Réponse 2 / 13
cs_kouki69 Messages postés 95 Date d'inscription lundi 27 mars 2006 Statut Membre Dernière intervention 28 août 2015
15 sept. 2009 à 09:19
Merci PCPT,
Ca me parait drolement compliqué pour fermer une application !
Apparemment, ça ne marche pas, peut-être parceque c'est du VB et non du VBA ?


Kouki
0
Réponse 3 / 13
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 47
15 sept. 2009 à 09:42
le SHELL renvoie un PID
ce qui est "compliqué" c'est juste de transformer ce PID en HANDLE

c'est ce HANDLE dont on a besoin pour fermer l'appli (ici envoyer le message simulant le click sur la croix 'fermer' dans la barre de titre de la fenêtre de FXWIN)

quel code as-tu saisi pour appeler le code que je t'ai indiqué?
en pas à pas, hPidAppPFX et InstanceToWnd(hPidAppPFX) te retournent bien des valeurs différentes de zero?

NB : code compatible VB6/VBA
0
Réponse 4 / 13
cs_kouki69 Messages postés 95 Date d'inscription lundi 27 mars 2006 Statut Membre Dernière intervention 28 août 2015
15 sept. 2009 à 10:02
J'utilise Call mais j'ai le message d'erreur suivant :

"Erreur de compilation, seuls des commentaires peuvent apparaitre après End Sub, End Function ou End Property"...pourtant, il n'y a ni l'un ni les autres ...????
La première ligne Private Declare Function FindWindows ... est soulignée lors du message d'erreur.


...
Call stopfx


Sub stopfx()

Private Const WM_CLOSE As Long = &H10
Private Const HTCAPTION As Long = 2&
Private Const GW_HWNDNEXT As Long = 2&
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Dim hPidAppPFX As Long


Private Sub FxRun()
hPidAppPFX = Shell("C:\NET\FX5\RUN\FXWIN.EXE")
End Sub

Private Sub FxStop()
Call SendMessage(InstanceToWnd(hPidAppPFX), WM_CLOSE, HTCAPTION, ByVal 0&)
End Sub

'http://www.codyx.org/snippet_recuperer-hwnd-handle-partir-pid-process-id_451.aspx#1462
Private Function InstanceToWnd(ByVal target_pid As Long) As Long 'API-Guid
Dim test_hwnd As Long, test_pid As Long, test_thread_id As Long
test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
Do While test_hwnd <> 0&
If GetParent(test_hwnd) = 0& Then
test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)
If test_pid = target_pid Then
InstanceToWnd = test_hwnd
Exit Do
End If
End If
test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
Loop
End Function

Kouki
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 13
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 47
15 sept. 2009 à 10:21
le code indiqué se mets tout en haut

tes 2 call doivent se faire dans une SUB (genre private sub tonbouton_click()), comme le message d'erreur l'indique

si tu préfères tu peux mettre tout mon code dans un module, en remplaçant
private sub FxRun()
private sub FxStop()

par
public sub FxRun()
public sub FxStop()
0
Réponse 6 / 13
cs_kouki69 Messages postés 95 Date d'inscription lundi 27 mars 2006 Statut Membre Dernière intervention 28 août 2015
15 sept. 2009 à 10:46
J'ai essayé comme ça, mais il n'y a rien à faire, le premier paquet de "private const private declare", il n'aime pas, tjrs le même message d'erreur. J'ai positionné de la manière suivante (tout mon code)


Private Sub CommandButton2_Click()

Dim chemin As Variant
Dim nomdefichier As String
Dim newnomdefichier As String
Dim newnomdefichier2 As String
Dim MyAppPFX, ReturnValue

Private Const WM_CLOSE As Long = &H10
Private Const HTCAPTION As Long = 2&
Private Const GW_HWNDNEXT As Long = 2&
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long



If TextBox1.Value = "" Then
MsgBox "please choose FX input file location", vbCritical
Else

Sheets("feuil1").Range("A1").Value = UserForm1.TextBox1.Value

nomdefichier = Sheets("feuil1").Range("A1").Value
newnomdefichier = "c:\net\fx5\work\files\new.dat"

FileCopy nomdefichier, newnomdefichier

Workbooks.OpenText Filename:=newnomdefichier, _
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1))
' Application.Run Range("AUTOSAUV.XLA!mcs02.OnTime")
Range("A1:O30").Select
Selection.Copy
Windows("fxtest2.xls").Activate
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Windows("new.dat").Activate
Range("F5").Select
Application.CutCopyMode = False
ActiveWorkbook.Close

Kill newnomdefichier

UserForm1.Hide

'Create the new pfx input file
Sheets("Case1").Select
Sheets("Case1").Copy
ActiveWorkbook.SaveAs Filename:="C:\net\fx5\work\files\run.dat", _
FileFormat:=xlText, CreateBackup:=False

ActiveWorkbook.Close


MyAppPFX = Shell("C:\NET\FX5\RUN\FXWIN.EXE")


ChDir "C:\net\fx5\work"
Workbooks.OpenText Filename:="C:\net\fx5\work\FX.OUT", Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
, 1))
Cells.Select
Selection.Copy
Windows("fxtest2.xls").Activate
Sheets("feuil5").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Windows("FX.OUT").Activate
Range("A1").Select

Application.CutCopyMode = False
ActiveWorkbook.Close



newnomdefichier2 = "C:\net\fx5\work\files\run.dat"
Kill newnomdefichier2

End If

Call FxStop

End Sub

Private Sub FxStop()
Call SendMessage(InstanceToWnd(MyAppPFX), WM_CLOSE, HTCAPTION, ByVal 0&)
End Sub

'http://www.codyx.org/snippet_recuperer-hwnd-handle-partir-pid-process-id_451.aspx#1462
Private Function InstanceToWnd(ByVal target_pid As Long) As Long 'API-Guid
Dim test_hwnd As Long, test_pid As Long, test_thread_id As Long
test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
Do While test_hwnd <> 0&
If GetParent(test_hwnd) = 0& Then
test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)
If test_pid = target_pid Then
InstanceToWnd = test_hwnd
Exit Do
End If
End If
test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
Loop
End Function
0
Réponse 7 / 13
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 47
15 sept. 2009 à 11:13
j'ai dit tout en haut

en plus tu as déplacé MyAppPFX, qui vaudra donc 0.
je le laisse dans la sub CLICK mais dans ce cas on supprime la sub STOP


code complet : 
Private Const WM_CLOSE As Long = &H10
Private Const HTCAPTION As Long = 2&
Private Const GW_HWNDNEXT As Long = 2&
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long


Private Sub CommandButton2_Click()

    Dim chemin As Variant
    Dim nomdefichier As String
    Dim newnomdefichier As String
    Dim newnomdefichier2 As String
    Dim MyAppPFX As Long
    
    
    If TextBox1.Value = "" Then
        MsgBox "please choose FX input file location", vbCritical
    Else
    
        Sheets("feuil1").Range("A1").Value = UserForm1.TextBox1.Value
        
        nomdefichier = Sheets("feuil1").Range("A1").Value
        newnomdefichier = "c:\net\fx5\work\files\new.dat"
        
        FileCopy nomdefichier, newnomdefichier
        
        Workbooks.OpenText FileName:=newnomdefichier, _
        Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1))
        ' Application.Run Range("AUTOSAUV.XLA!mcs02.OnTime")
        Range("A1:O30").Select
        Selection.Copy
        Windows("fxtest2.xls").Activate
        Range("A1").Select
        ActiveSheet.Paste
        Range("A1").Select
        Windows("new.dat").Activate
        Range("F5").Select
        Application.CutCopyMode = False
        ActiveWorkbook.Close
        
        Kill newnomdefichier
        
        UserForm1.Hide
        
        'Create the new pfx input file
        Sheets("Case1").Select
        Sheets("Case1").Copy
        ActiveWorkbook.SaveAs FileName:="C:\net\fx5\work\files\run.dat", _
        FileFormat:=xlText, CreateBackup:=False
        
        ActiveWorkbook.Close
        
        
        MyAppPFX = Shell("C:\NET\FX5\RUN\FXWIN.EXE")
        
        
        ChDir "C:\net\fx5\work"
        Workbooks.OpenText FileName:="C:\net\fx5\work\FX.OUT", Origin:= _
        xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
        , 1))
        
        Cells.Select
        Selection.Copy
        Windows("fxtest2.xls").Activate
        Sheets("feuil5").Select
        Range("A1").Select
        ActiveSheet.Paste
        Range("A1").Select
        Windows("FX.OUT").Activate
        Range("A1").Select
        
        Application.CutCopyMode = False
        ActiveWorkbook.Close
        
        
        
        newnomdefichier2 = "C:\net\fx5\work\files\run.dat"
        Kill newnomdefichier2
    
    End If
    
    Call SendMessage(InstanceToWnd(MyAppPFX), WM_CLOSE, HTCAPTION, ByVal 0&)

End Sub


'http://www.codyx.org/snippet_recuperer-hwnd-handle-partir-pid-process-id_451.aspx#1462
Private Function InstanceToWnd(ByVal target_pid As Long) As Long 'API-Guid
    Dim test_hwnd As Long, test_pid As Long, test_thread_id As Long
    test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
    Do While test_hwnd <> 0&
        If GetParent(test_hwnd) = 0& Then
            test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)
            If test_pid = target_pid Then
                InstanceToWnd = test_hwnd
                Exit Do
            End If
        End If
        test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
    Loop
End Function
0
Réponse 8 / 13
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 47
15 sept. 2009 à 11:16
oups, place le sendmessage avant le endif
pas besoin d'essayer de fermer ce qui n'a pas été ouvert
0
Réponse 9 / 13
cs_kouki69 Messages postés 95 Date d'inscription lundi 27 mars 2006 Statut Membre Dernière intervention 28 août 2015
15 sept. 2009 à 11:38
Ca tourne sans bug, par contre, l'application est toujours ouverte.
Par contre, l'exécutable qu'on lance (PFXWIN) semble lancer un logiciel qui s'appelle "WATCOM window application", et c'est cett eapplication qu'on veut fermer. Le PFXWIN ne lance rien d'autre
Dans le gestionnaire de tâche, l'exécutable PFWWIN.EXE est tjrs présent.


Private Const WM_CLOSE As Long = &H10
Private Const HTCAPTION As Long = 2&
Private Const GW_HWNDNEXT As Long = 2&
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long


Private Sub CommandButton2_Click()

Dim chemin As Variant
Dim nomdefichier As String
Dim newnomdefichier As String
Dim newnomdefichier2 As String
Dim MyAppPFX As Long


If TextBox1.Value = "" Then
MsgBox "please choose PFX input file location", vbCritical
Else

Sheets("feuil1").Range("A1").Value = UserForm1.TextBox1.Value

nomdefichier = Sheets("feuil1").Range("A1").Value
newnomdefichier = "c:\engnet\pfx51b\work\files\new.dat"

FileCopy nomdefichier, newnomdefichier

Workbooks.OpenText Filename:=newnomdefichier, _
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1))
' Application.Run Range("AUTOSAUV.XLA!mcs02.OnTime")
Range("A1:O30").Select
Selection.Copy
Windows("pfxtest2.xls").Activate
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Windows("new.dat").Activate
Range("F5").Select
Application.CutCopyMode = False
ActiveWorkbook.Close

Kill newnomdefichier

UserForm1.Hide

'Create the new pfx input file
Sheets("Case1").Select
Sheets("Case1").Copy
ActiveWorkbook.SaveAs Filename:="C:\engnet\pfx51b\work\files\run.dat", _
FileFormat:=xlText, CreateBackup:=False

ActiveWorkbook.Close


MyAppPFX = Shell("C:\ENGNET\PFX51B\RUN\PFXWIN.EXE")


ChDir "C:\engnet\pfx51b\work"
Workbooks.OpenText Filename:="C:\engnet\pfx51b\work\PFX.OUT", Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
, 1))

Cells.Select
Selection.Copy
Windows("pfxtest2.xls").Activate
Sheets("feuil5").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Windows("PFX.OUT").Activate
Range("A1").Select

Application.CutCopyMode = False
ActiveWorkbook.Close



newnomdefichier2 = "C:\engnet\pfx51b\work\files\run.dat"
Kill newnomdefichier2

Call SendMessage(InstanceToWnd(MyAppPFX), WM_CLOSE, HTCAPTION, ByVal 0&)


End If


End Sub


'http://www.codyx.org/snippet_recuperer-hwnd-handle-partir-pid-process-id_451.aspx#1462
Private Function InstanceToWnd(ByVal target_pid As Long) As Long 'API-Guid
Dim test_hwnd As Long, test_pid As Long, test_thread_id As Long
test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
Do While test_hwnd <> 0&
If GetParent(test_hwnd) = 0& Then
test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)
If test_pid = target_pid Then
InstanceToWnd = test_hwnd
Exit Do
End If
End If
test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
Loop
End Function
Merci pour ta patience ...
0
Réponse 10 / 13
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 47
15 sept. 2009 à 12:02
à essayer :


en haut, avec les autres DECLARE, ajoute ceci :
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long

ensuite remplace
Call SendMessage(InstanceToWnd(MyAppPFX), WM_CLOSE, HTCAPTION, ByVal 0&)
par :
Dim hProcess as Long
hProcess = OpenProcess(1&, False, MyAppPFX)
call TerminateProcess(hProcess, 4&)

si çà ne suffit pas il faudra enumérer les processus
voir alors dans les sources existantes

++
0
Réponse 11 / 13
cs_kouki69 Messages postés 95 Date d'inscription lundi 27 mars 2006 Statut Membre Dernière intervention 28 août 2015
15 sept. 2009 à 13:16
Pas d'évolution...
S'il faut énumérer les processus, dois-je aller dans gestionnaire de tâches, processus ??j'en ai 61 actuellement.


Private Const WM_CLOSE As Long = &H10
Private Const HTCAPTION As Long = 2&
Private Const GW_HWNDNEXT As Long = 2&
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long

Private Sub CommandButton2_Click()

Dim chemin As Variant
Dim nomdefichier As String
Dim newnomdefichier As String
Dim newnomdefichier2 As String
Dim MyAppPFX As Long


If TextBox1.Value = "" Then
MsgBox "please choose PFX input file location", vbCritical
Else

Sheets("feuil1").Range("A1").Value = UserForm1.TextBox1.Value

nomdefichier = Sheets("feuil1").Range("A1").Value
newnomdefichier = "c:\engnet\pfx51b\work\files\new.dat"

FileCopy nomdefichier, newnomdefichier

Workbooks.OpenText Filename:=newnomdefichier, _
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1))
' Application.Run Range("AUTOSAUV.XLA!mcs02.OnTime")
Range("A1:O30").Select
Selection.Copy
Windows("pfxtest2.xls").Activate
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Windows("new.dat").Activate
Range("F5").Select
Application.CutCopyMode = False
ActiveWorkbook.Close

Kill newnomdefichier

UserForm1.Hide

'Create the new pfx input file
Sheets("Case1").Select
Sheets("Case1").Copy
ActiveWorkbook.SaveAs Filename:="C:\engnet\pfx51b\work\files\run.dat", _
FileFormat:=xlText, CreateBackup:=False

ActiveWorkbook.Close


MyAppPFX = Shell("C:\ENGNET\PFX51B\RUN\PFXWIN.EXE")


ChDir "C:\engnet\pfx51b\work"
Workbooks.OpenText Filename:="C:\engnet\pfx51b\work\PFX.OUT", Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
, 1))

Cells.Select
Selection.Copy
Windows("pfxtest2.xls").Activate
Sheets("feuil5").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Windows("PFX.OUT").Activate
Range("A1").Select

Application.CutCopyMode = False
ActiveWorkbook.Close



newnomdefichier2 = "C:\engnet\pfx51b\work\files\run.dat"
Kill newnomdefichier2

Dim hProcess As Long
hProcess = OpenProcess(1&, False, MyAppPFX)
Call TerminateProcess(hProcess, 4&)


End If


End Sub


'http://www.codyx.org/snippet_recuperer-hwnd-handle-partir-pid-process-id_451.aspx#1462
Private Function InstanceToWnd(ByVal target_pid As Long) As Long 'API-Guid
Dim test_hwnd As Long, test_pid As Long, test_thread_id As Long
test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
Do While test_hwnd <> 0&
If GetParent(test_hwnd) = 0& Then
test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)
If test_pid = target_pid Then
InstanceToWnd = test_hwnd
Exit Do
End If
End If
test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
Loop
End Function
Kouki
0
Réponse 12 / 13
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 47
15 sept. 2009 à 22:08
[quote=kouki69]S'il faut énumérer les processus, dois-je aller dans gestionnaire de tâches, processus/quoteon ne parle pas de manip manuelle mais de dev!

si le code indiqué est sans effet (j'avais un doute quand même), voir ENUM PROCESS, le moteur de recherche de codes-sources est assez performant
0
Réponse 13 / 13
bubu60 Messages postés 7 Date d'inscription vendredi 18 juillet 2003 Statut Membre Dernière intervention 25 septembre 2009
25 sept. 2009 à 11:03
Bonjour,
pour moi pas d'erreur de syntaxe mais le code ne fonctionne pas.
J'ai essayé un code trouvé sur un autre forum, c'est pareil, pas de fermeture de l'application lancée par shell.

Il y a une spécificité pour moi, l'appli lancée se met dans la zone de notification (En bas à droite), peut être ça ne fonctonne pas avec ce genre d'appli.

une idée ?
Merci

Je mets mon code :

Option Compare Database
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const WM_CLOSE As Long = &H10
Private Const HTCAPTION As Long = 2&
Private Const GW_HWNDNEXT As Long = 2&
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Function Envoiemail(A As String, Sujet As String, Corps As String)
' Necessite le référence : Microsoft Outlook x.x Object Library
Dim MonOutlook As Object
Dim MonMessage As Object
Dim ret As Variant
Dim click As Variant

'Ouverture Click Yes
click = Shell("C:\Program Files\Express ClickYes\ClickYes.exe", vbMinimizedNoFocus)
Sleep (1000)

' On teste si Outlook est ouvert
Set appli_outlook = Outlook.Application
If appli_outlook.Explorers.Count = 0 Then
' On lance Outlook
ret = 0
ret = Shell("C:\Program Files\Microsoft Office\OFFICE11\OUTLOOK.EXE", vbNormalFocus)
Do Until ret <> 0
DoEvents
Loop
End If
Set appli_outlook = Nothing

' On envoie le message
Set MonOutlook = Outlook.Application
Set MonMessage = MonOutlook.createitem(0)
MonMessage.To = A
MonMessage.Subject = Sujet
MonMessage.body = Corps
MonMessage.Send

' Pause de 15 secondes pour être certain que le mail est envoyé à outlook
Sleep (15000)

' Fermeture d'Outlook
MonOutlook.Quit
Set MonMessage = Nothing
Set MonOutlook = Nothing

'Fermeture Click Yes
Call SendMessage(InstanceToWnd(click), WM_CLOSE, HTCAPTION, ByVal 0&)
End Function

Public Sub test_envoie()
Dim ret
ret = Envoiemail("xxxxxx@yahoo.fr", "Test mail", "Corps du message")
End Sub

Private Function InstanceToWnd(ByVal target_pid As Long) As Long 'API-Guid
Dim test_hwnd As Long, test_pid As Long, test_thread_id As Long
test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
Do While test_hwnd <> 0&
If GetParent(test_hwnd) = 0& Then
test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)
If test_pid = target_pid Then
InstanceToWnd = test_hwnd
Exit Do
End If
End If
test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
Loop
End Function
0

Discussions similaires

Erreur du serveur dans l'application '/'
cs_ange_sali -
Dr_shaman -

5 réponses
Exemple d'une application web avec j2EE
lobnalobna -
lobnalobna -

2 réponses
Turbo C++
cs_jrod -
cmarsc -

1 réponse
des exemples des application avec J2EE
fatine87 -
fatine87 -

3 réponses
déploiement d'une application J2EE avec NetBeans?
yosboss -
missavril -

9 réponses
Rejoignez-nous