ShellWait en VBA ?

Salut les amis,

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

Code:

---

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.

Code:

---

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

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

Code:

---

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 ?

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

Code:

---

1 2	Private Declare Private Declare Ptrsafe

---

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

Code:

---

#if win32 then

---

Code:

---

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

---

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:

---

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:

---

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.

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:

---

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.

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:

---

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:

---

1 2 3 4 5

#If Win32 then Private Declare #Else Private Declare Ptrsafe #End If

---

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

Code:

---

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 ?

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.

Citation:

---

Envoyé par Zebulon777

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

Code:

---

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 ?

---

Citation:

---

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:

---

Shell "notepad.exe"

---

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":
http://www.developpez.net/forums/att...1&d=1378204477

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.

Citation:

---

Envoyé par Zebulon777

LOL, ne vous battez pas.

---

:D
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.

Citation:

---

É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.

Citation:

---

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 ?

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!

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:

---

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.

Citation:

---

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.

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

Citation:

---

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:

---

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:

---

1 2 3 4 5

#If Win64 then Declare Ptrsafe #else Declare #end if

---

discussion en court.

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

Code:

---

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

---

Suivi du code mis en exemple:

Code:

---

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:

---

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.

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:

---

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

---

Merci à tous pour votre aide.