Thanks for the help
But this also is not working..!!!
> This is a multi-part message in MIME format.
------=_NextPart_000_00A2_01C212DF.E0F11C60
Content-Type: text/plain;
charset="Windows-1252"
Content-Transfer-Encoding: quoted-printable
Tom,
Try the following code, it works for me:
Regards,
Walt
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
=
=3D
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 STATUS_PENDING =3D &H103&
Private Const PROCESS_QUERY_INFORMATION =3D &H400
Public Function ShellandWait(ExeFullPath As String, _
Optional TimeOutValue As Long =3D 0) As Boolean
=20
Dim lInst As Long
Dim lStart As Long
Dim lTimeToQuit As Long
Dim sExeName As String
Dim lProcessId As Long
Dim lExitCode As Long
Dim bPastMidnight As Boolean
=20
On Error GoTo ErrorHandler
lStart =3D CLng(Timer)
sExeName =3D ExeFullPath
'Deal with timeout being reset at Midnight
If TimeOutValue > 0 Then
If lStart + TimeOutValue < 86400 Then
lTimeToQuit =3D lStart + TimeOutValue
Else
lTimeToQuit =3D (lStart - 86400) + TimeOutValue
bPastMidnight =3D True
End If
End If
lInst =3D Shell(sExeName, vbMinimizedNoFocus)
=20
lProcessId =3D OpenProcess(PROCESS_QUERY_INFORMATION, False, lInst)
Do
Call GetExitCodeProcess(lProcessId, lExitCode)
DoEvents
If TimeOutValue And Timer > lTimeToQuit Then
If bPastMidnight Then
If Timer < lStart Then Exit Do
Else
Exit Do
End If
End If
Loop While lExitCode =3D STATUS_PENDING
=20
ShellandWait =3D True
=20
ErrorHandler:
ShellandWait =3D False
Exit Function
End Function
------=_NextPart_000_00A2_01C212DF.E0F11C60
Content-Type: text/html;
charset="Windows-1252"
Content-Transfer-Encoding: quoted-printable
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML><HEAD>
<META http-equiv=3DContent-Type content=3D"text/html; =
charset=3Dwindows-1252">
<META content=3D"MSHTML 6.00.2600.0" name=3DGENERATOR>
<STYLE></STYLE>
</HEAD>
<BODY bgColor=3D#ffffff>
<DIV><FONT face=3DTahoma size=3D2>Tom,</FONT></DIV>
<DIV><FONT face=3DTahoma size=3D2></FONT> </DIV>
<DIV><FONT face=3DTahoma size=3D2>Try the following code, it works for=20
me:</FONT></DIV>
<DIV><FONT face=3DTahoma size=3D2></FONT> </DIV>
<DIV><FONT face=3DTahoma size=3D2>Regards,</FONT></DIV>
<DIV><FONT face=3DTahoma size=3D2></FONT> </DIV>
<DIV><FONT face=3DTahoma size=3D2>Walt</FONT></DIV>
<DIV><FONT face=3DTahoma size=3D2></FONT> </DIV>
<DIV><FONT face=3DTahoma=20
size=3D2>=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
=
=3D=3D=3D=3D</FONT></DIV>
<DIV><FONT face=3DTahoma size=3D2></FONT> </DIV>
<DIV>Private Declare Function OpenProcess Lib "kernel32" _<BR>(ByVal=20
dwDesiredAccess As Long, ByVal bInheritHandle As Long, _<BR>ByVal =
dwProcessId As=20
Long) As Long</DIV>
<DIV><FONT face=3DTahoma size=3D2></FONT> </DIV>
<DIV>Private Declare Function GetExitCodeProcess Lib "kernel32" =
_<BR>(ByVal=20
hProcess As Long, lpExitCode As Long) As Long</DIV>
<DIV><FONT face=3DTahoma size=3D2></FONT> </DIV>
<DIV>Private Const STATUS_PENDING =3D &H103&<BR>Private Const=20
PROCESS_QUERY_INFORMATION =3D &H400</DIV>
<DIV><FONT face=3DTahoma size=3D2></FONT> </DIV>
<DIV>Public Function ShellandWait(ExeFullPath As String, _<BR>Optional=20
TimeOutValue As Long =3D 0) As Boolean<BR> =20
<BR> Dim lInst As Long<BR> Dim =
lStart As=20
Long<BR> Dim lTimeToQuit As Long<BR> =
Dim=20
sExeName As String<BR> Dim lProcessId As=20
Long<BR> Dim lExitCode As Long<BR> =
Dim=20
bPastMidnight As Boolean<BR> <BR> On =
Error=20
GoTo ErrorHandler</DIV>
<DIV><FONT face=3DTahoma size=3D2></FONT> </DIV>
<DIV> lStart =3D CLng(Timer)<BR> =
sExeName =3D=20
ExeFullPath</DIV>
<DIV><FONT face=3DTahoma size=3D2></FONT> </DIV>
<DIV> 'Deal with timeout being reset at=20
Midnight<BR> If TimeOutValue > 0=20
Then<BR> If lStart + =
TimeOutValue <=20
86400 =
Then<BR>  =
;=20
lTimeToQuit =3D lStart +=20
TimeOutValue<BR> =20
Else<BR>  =
;=20
lTimeToQuit =3D (lStart - 86400) +=20
TimeOutValue<BR> &nb=
sp; =20
bPastMidnight =3D True<BR> End =
If<BR> End If</DIV>
<DIV><FONT face=3DTahoma size=3D2></FONT> </DIV>
<DIV> lInst =3D Shell(sExeName,=20
vbMinimizedNoFocus)<BR> <BR>lProcessId =3D=20
OpenProcess(PROCESS_QUERY_INFORMATION, False, lInst)</DIV>
<DIV><FONT face=3DTahoma size=3D2></FONT> </DIV>
<DIV> Do<BR> =
Call=20
GetExitCodeProcess(lProcessId,=20
lExitCode)<BR> =20
DoEvents<BR> If TimeOutValue =
And Timer=20
> lTimeToQuit=20
Then<BR>  =
; If=20
bPastMidnight=20
Then<BR>  =
; =20
If Timer < lStart Then Exit=20
Do<BR> =
Else<BR>  =
; =20
Exit =
Do<BR> =
End If<BR> End If<BR> Loop While =
lExitCode =3D=20
STATUS_PENDING<BR> <BR> ShellandWait =
=3D=20
True<BR> <BR>ErrorHandler:<BR>ShellandWait =3D False<BR>Exit =
Function<BR>End Function<BR></DIV>
<DIV><FONT face=3DTahoma size=3D2></FONT> </DIV>
<DIV><FONT face=3DTahoma size=3D2></FONT> </DIV></BODY></HTML>
------=_NextPart_000_00A2_01C212DF.E0F11C60--
View Cart
