ShellWait en VBA ?

**Zebulon777** · 02/09/2013, 13h49

Salut les amis,

depuis assez longtemps j'utilise une procédure pour exécuter des commandes externes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
Public Sub ShellWait(ByVal JobToDo As String)
Dim hProcess As Long, RetVal As Long
 
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(JobToDo, vbMinimizedNoFocus))
    Do
        GetExitCodeProcess hProcess, RetVal
        DoEvents
'        Sleep 10
    Loop While RetVal = STILL_ACTIVE
End Sub

Cette procédure fonctionne impec sous Windows XP, mais impossible de la faire fonctionner sous Windows 7.

Sur la ligne, "hProcess=...", j'ai le message d'erreur :
erreur d'exécution 53
Fichier introuvable.

Merci d'avance pour votre aide.

Invité · 02/09/2013, 14h09

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
#if win32 then
Private Declare Function OpenProcess
#else
Private Declare Ptrsafe  Function OpenProcess
#end if

idem pour toutes tes déclarations

**Zebulon777** · 02/09/2013, 14h56

Je ne comprends pas.
Dans mon code, j'ai déjà les déclarations :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
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
Private Const STILL_ACTIVE = &H103
Private Const PROCESS_QUERY_INFORMATION = &H400
Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long

Je dois ajouter ton code à la suite ?

Invité · 02/09/2013, 15h00

la déclaration est différente suivant la version de Windows

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Private Declare
Private Declare Ptrsafe

c'est pour cela que j'intègre des directives de compilation

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 #if win32 then

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Const STILL_ACTIVE = &H103
Private Const PROCESS_QUERY_INFORMATION = &H400
#if win32 then
     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
     Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
#Else
       private Declare Ptrsafe  Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Ptrsafe  Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
      Declare  Ptrsafe  Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
#end if

Invité · 03/09/2013, 00h01

Salut rdurupt,

Il faut toujours mettre Win64 avant Win32. La raison est que Win32 n'est pas la version du Windows ou la version du Excel mais est une compatibilité. Un Excel 64 bit est vu par le VBA comme étant compatible 32 bit, mais non compatible 16 bit. Il y a un ordre typique:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
#If Win64 Then
    MsgBox "Win64"
#ElseIf Win32 Then
    MsgBox "Win32"
#ElseIf Win16 Then
    MsgBox "Win16"
#End If

Si Win64 passe, les autres sont rejeté grâce à ElseIf. En passant Win32 en 1er, un système 64 bit verra Win32 comme étant OK et ira dans le #If et rejètera le Else/ElseIf.

C'est la même chose pour les VBA6/7. Il ne s'agit pas d'une version mais d'une compatibilité. La constante de compile VBA6 passera sur un Excel 2010 ou 2013.

Je pense qu'il vaut mieux déclarer avec la constante VBA7 plutôt, quitte à insérer un Win64 dans le VBA7 comme ça doit être le cas par exemple avec la fonction GetTickCount64 qui s'appel GetTickCount sous Windows 32 bit et il faut utiliser un Alias pour par exemple les appeler tous les deux GTC3264 dans la déclaration pour pouvoir être appelé dans le code par un même nom.

Sinon, très souvent (il y a surement des exceptions), les noms commençant par h tel que Hwnd, hProcess, hThread, hInstance, hModule etc... sont des handle a déclarer uniquement en LongPtr (ou soit en LongLong si la constante de compile est Win64 par exemple, mais pas obligatoire).

-----------------------------------------------------------------------------------------------------------

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
#If VBA7 Then
    Private Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" ( _
                    ByVal hProcess As LongPtr, lpExitCode As Long) As Long
    Private Declare PtrSafe Function OpenProcess Lib "kernel32" ( _
                    ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
                    ByVal dwProcessID As Long) As LongPtr
    Declare PtrSafe Function mciExecute Lib "winmm.dll" ( _
            ByVal lpstrCommand As String) As Long
#Else
     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
     Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
#End If
Private Const STILL_ACTIVE = &H103
Private Const PROCESS_QUERY_INFORMATION = &H400
 
 
Public Sub ShellWait(ByVal JobToDo As String)
#If VBA7 Then
    Dim hProcess As LongPtr
#Else
    Dim hProcess As Long
#End If
Dim RetVal As Long
 
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(JobToDo, vbMinimizedNoFocus))
    Do
        GetExitCodeProcess hProcess, RetVal
        DoEvents
    Loop While RetVal = STILL_ACTIVE
End Sub
 
Public Sub TestApplication()
    ShellWait "NOTEPAD.EXE"
    MsgBox "Process Fini"
End Sub

---------------------------------------------------------------------

Mais sinon, je pense que le problème de Zebulon777 est ailleurs. Il ne nous dit pas si Win7/Excel est en 64 bit ou non.
Si il est en 32 bit, le code ne devrai pas changer pourtant entre WinXP et Win7.

**Zebulon777** · 03/09/2013, 07h59

Merci pour vos réponses, les gars, mais je suis encore plus embrouillé...

Avant l'application fonctionnait très bien sur Win XP 32 / Excel 2003.
Il faut maintenant que nous fassions en sorte que l'application en question fonctionne AUSSI sous Win 7 64 / Excel 2003 ET Excel 2010.

Voici donc le code que nous avons :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
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
Private Const STILL_ACTIVE = &H103
Private Const PROCESS_QUERY_INFORMATION = &H400
 
Public Sub ShellWait(ByVal JobToDo As String)
Dim hProcess As Long, RetVal As Long
 
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(JobToDo, vbMinimizedNoFocus))
    Do
        GetExitCodeProcess hProcess, RetVal
        DoEvents
'        Sleep 10
    Loop While RetVal = STILL_ACTIVE
End Sub

Donc, ce code ne fonctionne pas sous Win7-64 / Excel 2003, mais je n'ai pas encore pu le tester avec Excel 2010.

Invité · 03/09/2013, 09h17

Bonjour,
l'application fonctionne sous Xp car il travail en 32 bits et que les déclaration que tu fait dans ton code correspondent à du 32 bits.

pour que ton application fonctionne tu dois les déclarées dans leurs version bits.

le problème est qu'après modification, elle ne fonctionnerons plus sur 32 bits.

pour t'en convaincre, fais une copie de ton fichier (MonXls64.xls) et modifies les déclaration comme suit:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Private Const STILL_ACTIVE = &H103
Private Const PROCESS_QUERY_INFORMATION = &H400
private Declare Ptrsafe  Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Ptrsafe  Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare  Ptrsafe  Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long

c'est pour cela que l'on doit ajouter des directive de compliation:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
#If Win32 then
Private Declare
#Else
Private Declare Ptrsafe 
#End If

**Zebulon777** · 03/09/2013, 10h17

Je suis sur plusieurs projets en même temps... arf...
Donc si j'ai bien compris je fais ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
#If Win32 then
     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
     Private Const STILL_ACTIVE = &H103
     Private Const PROCESS_QUERY_INFORMATION = &H400
#Else
     Private Const STILL_ACTIVE = &H103
     Private Const PROCESS_QUERY_INFORMATION = &H400
     private Declare Ptrsafe  Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
     Private Declare Ptrsafe  Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
     Private Declare  Ptrsafe  Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
#End If

Et je met ce morceau de code à la place de mes déclarations ?

Invité · 03/09/2013, 11h09

Salut,

Je suis presque sûr que ça ne provient pas des déclarations. Sans gestion d'erreur, les appel d'API ont tendance à faire planter l'application EXCEL généralement.

Je trouve qu'il manque un bout de code. Le code qui appel la fonction et notamment ce que tu met dans le JobToDo.

As-tu essayé d'appeler NOTEPAD.EXE ? Il a la propriété d'être dans beaucoup de répertoire différents. Il est dans 3 répertoires différents chez moi:
"C:\Windows\System32"
"C:\Windows"
"C:\Windows\SysWOW64"

As-tu essayé le bout de code que j'ai mis sinon ? A mettre dans un module.
Ajoute une petite gestion d'erreur au cas où puisqu'il s'agit d'un appel avec API.

Invité · 03/09/2013, 11h19

Envoyé par Zebulon777

Je suis sur plusieurs projets en même temps... arf...
Donc si j'ai bien compris je fais ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
#If Win32 then
     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
     Private Const STILL_ACTIVE = &H103
     Private Const PROCESS_QUERY_INFORMATION = &H400
#Else
     Private Const STILL_ACTIVE = &H103
     Private Const PROCESS_QUERY_INFORMATION = &H400
     private Declare Ptrsafe  Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
     Private Declare Ptrsafe  Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
     Private Declare  Ptrsafe  Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
#End If

Et je met ce morceau de code à la place de mes déclarations ?

Envoyé par Nouveau2

Salut,
As-tu essayé d'appeler NOTEPAD.EXE ? Il a la propriété d'être dans beaucoup de répertoire différents. Il est dans 3 répertoires différents chez moi:
"C:\Windows\System32"
"C:\Windows"
"C:\Windows\SysWOW64"

pour Notepad, son emplacement est défini dans la base de registre pas besoin de lui définir le chemin.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Shell "notepad.exe"

Invité · 03/09/2013, 11h59

Justement, si l'appel à NOTEPAD.EXE fonctionne avec la fonction, ça signifiera que ça ne provient pas des déclarations mais bien du manque de précision de l'emplacement de l'objet à appeler.
Dans ce cas, ça ne serait pas un problème de programmation mais plutôt un problème de savoir si les fichiers sur son Win7 son déclaré dans sa base de registre. Peut être avait-il l'habitude d'appeler un fichier sans préciser l'emplacement auparavant, et maintenant, l'appel de se fichier sur son nouveau Win7 échoue car il faut préciser son emplacement.

C'est pour ça qu'il manque un bout de code, celui où on voit si l'appel inclus le répertoire du fichier ou non.
Si l'emplacement exacte du fichier est spécifié, alors, peut être que le problème est ailleurs, mais il faudrait tout de même savoir. Mais déjà savoir si le cas NOTEPAD marche déjà serait un début.

J'obtient bien une erreur 53 en appelant Notepad avec un s "NOTEPADS.EXE":

**Zebulon777** · 03/09/2013, 12h49

LOL, ne vous battez pas.

Avec "NOTEPAD.EXE", ça fonctionne.
Le Notepad s'ouvre bien et le programme ne reprend que lorsque je ferme le bloc note.

Invité · 03/09/2013, 13h56

Envoyé par Zebulon777

LOL, ne vous battez pas.

Pour ma part, je ne me absolument pas. Ma 1ère intervention été juste une information montrant que sur un système 64 bit, Win32 renvoie vrai et qu'il faut toujours faire passer Win64 avant Win32.

Étant donné que Win32 renvoie la valeur True sur les plateformes de développement 32 bits et 64 bits, il est important que l’ordre dans la directive #If...Then...#Else renvoie les résultats souhaités dans votre code. Par exemple, étant donné que Win32 renvoie la valeur True en 64 bits (Win32 est compatible dans les environnements Win64), si vous vérifiez Win32 avant Win64 la condition Win64 ne s’exécute jamais car Win32 renvoie la valeur True. L’ordre suivant renvoie des résultats prévisibles :

http://msdn.microsoft.com/fr-fr/libr.../gg264614.aspx
Ça partait d'une bonne intention en tout cas. C'était informatif et ça reste bon à savoir si on veux rendre compatible des programmes en 32 et 64 bit.

Envoyé par Zebulon777

Avec "NOTEPAD.EXE", ça fonctionne.
Le Notepad s'ouvre bien et le programme ne reprend que lorsque je ferme le bloc note.

Donc, c'est bon si tu spécifie l'emplacement du fichier ?

Invité · 03/09/2013, 14h03

dans le lien que tu propose, il parle de Win16. vue que tous ce qui marchait en 16Bts ne fonctionne plus en 32Bts ?

à l'heure où on parle, tester le Win32 me parait suffisant mais pourquoi pas tester le Win64 avant le Win32!

Invité · 03/09/2013, 14h18

Malheureusement, Win32 renvoie vrai en 64 bit.

Sur Excel 64 bit:
Win64 renvoie vrai
Win32 renvoie vrai
Win16 renvoie faux et est ignoré si on déclare des API par #if Win16 then

Sur Excel 32 bit:
Win64 renvoie faux
Win32 renvoie vrai
XWin16 renvoi faux

Si on déclare sous la forme:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
#If Win32 then
   Declare
#else
   Declare Ptrsafe
#end if

Un système 64 bit (Windows 64 + Excel 64) ira dans la branche Win32 car elle renverra vrai et donc le code déclaré initialement pour un système 32 bit (sans ptrsafe et sans les handle/pointeur en LongLong) sera lu par le système 64 bit et donc ne fonctionnera pas.

La branche #else ne sera lu que pour les système compatible Win16 puisqu'il n'y a que 3 types de constantes de compilation conditionnel lié au nombre de bit (Win16, Win32 et Win64). Le #Else ici correspond donc finalement à un #if Win16.

Envoyé par rdurupt

dans le lien que tu propose, il parle de Win16. vue que tous ce qui marchait en 16Bts ne fonctionne plus en 32Bts ?

Je ne sais pas dutout si les anciennes déclarations au temps des Windows 16 bit fonctionnent sur les systèmes VBA actuels par contre.

Invité · 03/09/2013, 15h22

vba 16 Bts ne tourne pas en 32Bts et je suis pas sur que même Excel fonctione

Envoyé par Nouveau2

Malheureusement, Win32 renvoie vrai en 64 bit.

Sur Excel 64 bit:
Win64 renvoie vrai
Win32 renvoie vrai
Win16 renvoie faux et est ignoré si on déclare des API par #if Win16 then

Sur Excel 32 bit:
Win64 renvoie faux
Win32 renvoie vrai
XWin16 renvoi faux

Si on déclare sous la forme:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
#If Win32 then
   Declare
#else
   Declare Ptrsafe
#end if

Un système 64 bit (Windows 64 + Excel 64) ira dans la branche Win32 car elle renverra vrai et donc le code déclaré initialement pour un système 32 bit (sans ptrsafe et sans les handle/pointeur en LongLong) sera lu par le système 64 bit et donc ne fonctionnera pas.

La branche #else ne sera lu que pour les système compatible Win16 puisqu'il n'y a que 3 types de constantes de compilation conditionnel lié au nombre de bit (Win16, Win32 et Win64). Le #Else ici correspond donc finalement à un #if Win16.

alors test que Win64

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
#If Win64 then
   Declare Ptrsafe
#else
   Declare 
#end if

discussion en court.

Invité · 09/09/2013, 14h22

Je ne connais pas mciExecute,
A essayer pour voir. Uniquement la déclaration initiale

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long

Suivi du code mis en exemple:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Dim X as long
' Nom et chemin de votre fichier WAV ou AVI
X = mciExecute("play C:\windows\message_sonore_inexistant.wav")

Essaye comme ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Private Sub TestAudio()
On Error GoTo Gestion_Erreurs
mciExecute "play I:\FichierTest.wav"
Gestion_Erreurs:
End Sub

Si Excel ne plante pas avec l'API, tu peux enlever la gestion d'erreur.

**Zebulon777** · 16/10/2013, 10h46

Désolé, j'avais oublié ce message, mais la réponse a été trouvée dans un autre message.
Il suffit d'ajouter le paramètre "wait" à la commande mciExecute :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
mciExecute ("play " & WFichier_txt) & " wait"

Merci à tous pour votre aide.

ShellWait en VBA ?

Macros et VBA Excel

Discussions similaires

Partager

Partager