plq
asked on
Shell Document and Wait
I have this function which shells a document
Public Function ShellDocument(sDoc As String, Optional sParams As String = "")
Dim Scr_hDC As Integer
SetContext "Shelling Document " & sDoc
Scr_hDC = GetDesktopWindow()
ShellDocument = ShellExecute(Scr_hDC, "Open", sDoc, sParams, "C:\", SW_SHOWNORMAL)
End Function
.... and I have this function which shells an EXE and waits for it to finish........
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const PROCESS_QUERY_INFORMATION = 1024
'
Public Sub ShellWait(sPath As String, lSecondsTimeOut As Long)
Dim hProcess As Long, hOpenProcess As Long
Dim lCount As Long
gsContext = "Waiting for " & sPath
hProcess = Shell(sPath, vbNormalFocus)
Do
'Open a handle to the process requesting query permissions
hOpenProcess = OpenProcess(PROCESS_QUERY_ INFORMATIO N, 0, hProcess)
'If we were successful
If hOpenProcess <> 0 Then
CloseHandle hOpenProcess
Else
Sleep 100 ' Safety net for disk writes etc
Exit Sub
End If
Sleep 100 ' one tenth of a second
lCount = lCount + 1
DoEvents
If lCount > 10 * lSecondsTimeOut And lSecondsTimeOut > 0 Then Exit Sub ' 10 seconds
Loop
End Sub
......... what I want is to merge the two somehow to give me a ShellDocumentAndWait function
Any ideas ?
Public Function ShellDocument(sDoc As String, Optional sParams As String = "")
Dim Scr_hDC As Integer
SetContext "Shelling Document " & sDoc
Scr_hDC = GetDesktopWindow()
ShellDocument = ShellExecute(Scr_hDC, "Open", sDoc, sParams, "C:\", SW_SHOWNORMAL)
End Function
.... and I have this function which shells an EXE and waits for it to finish........
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const PROCESS_QUERY_INFORMATION = 1024
'
Public Sub ShellWait(sPath As String, lSecondsTimeOut As Long)
Dim hProcess As Long, hOpenProcess As Long
Dim lCount As Long
gsContext = "Waiting for " & sPath
hProcess = Shell(sPath, vbNormalFocus)
Do
'Open a handle to the process requesting query permissions
hOpenProcess = OpenProcess(PROCESS_QUERY_
'If we were successful
If hOpenProcess <> 0 Then
CloseHandle hOpenProcess
Else
Sleep 100 ' Safety net for disk writes etc
Exit Sub
End If
Sleep 100 ' one tenth of a second
lCount = lCount + 1
DoEvents
If lCount > 10 * lSecondsTimeOut And lSecondsTimeOut > 0 Then Exit Sub ' 10 seconds
Loop
End Sub
......... what I want is to merge the two somehow to give me a ShellDocumentAndWait function
Any ideas ?
ASKER
Excel code would be fine. Please post it !
thanks
thanks
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Sorry,
> .nShow = SW_HIDE
In your case this should probably be
.nShow = SW_NORMAL
See the values available in the ShowWindow API.
.. Alan
> .nShow = SW_HIDE
In your case this should probably be
.nShow = SW_NORMAL
See the values available in the ShowWindow API.
.. Alan
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) 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 GetExitCodeProcess Lib "Kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Const STILL_ACTIVE = &H103
Const PROCESS_QUERY_INFORMATION = &H400
Private Function ShellDocumentAndWait(Docum entName, Optional WindowStyle As VbAppWinStyle = vbNormalFocus) As Double
Dim hProcess As Long, RetVal As Long, strEXE As String * 255
Call FindExecutable(DocumentNam e, "", strEXE)
hProcess = OpenProcess(PROCESS_QUERY_ INFORMATIO N, False, Shell(Left$(strEXE, InStr(strEXE, Chr$(0)) - 1) & " " & DocumentName, WindowStyle))
Do
GetExitCodeProcess hProcess, RetVal
DoEvents: Sleep 100
Loop While RetVal = STILL_ACTIVE
End Function
Private Sub Command1_Click()
ShellDocumentAndWait "C:\Test.xls", vbNormalFocus
MsgBox "Document has been closed!"
End Sub
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 Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Const STILL_ACTIVE = &H103
Const PROCESS_QUERY_INFORMATION = &H400
Private Function ShellDocumentAndWait(Docum
Dim hProcess As Long, RetVal As Long, strEXE As String * 255
Call FindExecutable(DocumentNam
hProcess = OpenProcess(PROCESS_QUERY_
Do
GetExitCodeProcess hProcess, RetVal
DoEvents: Sleep 100
Loop While RetVal = STILL_ACTIVE
End Function
Private Sub Command1_Click()
ShellDocumentAndWait "C:\Test.xls", vbNormalFocus
MsgBox "Document has been closed!"
End Sub
ASKER
vinnyd79 - Thanks for the compact solution, but I didn't fancy the assumption that %1 would ALWAYS be the parameter
So, I took ADSaunders solution, added a few constants and cleaned up a bit, and that worked fine.
Thanks to everyone for helping.
So, I took ADSaunders solution, added a few constants and cleaned up a bit, and that worked fine.
Thanks to everyone for helping.
Thanks,
.. Alan
.. Alan
%1 ?
ASKER
vinny: Shell app & " " & param. Its assuming that the first param is correct whereas the reality might be "app /parama /paramb /document " & param
I think shellexecuteex insulates you from this.
I think shellexecuteex insulates you from this.
Have you tried using the ShellExecuteEx(), WaitForInputIdle(), & WaitForSingleObject() API calls instead?
I could post some code that works in Excel VBA & a suggestion to change it for Visual Basic if you wish.
BFN,
fp.