However, I need to update it so that it returns an error message if any one of the steps don't finish correctly. (i.e. if the PW is bad).
Thanks for any help that could be provided.
Code:
Expand|Select|Wrap|Line Numbers
- Option Explicit
- 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 = &H103&
- Private Const PROCESS_QUERY_INFORMATION = &H400
- Public Function ShellandWait(ExeFullPath As String, _
- Optional TimeOutValue As Long = 0) As Boolean
- 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
- On Error GoTo ErrorHandler
- lStart = CLng(Timer)
- sExeName = ExeFullPath
- 'Deal with timeout being reset at Midnight
- If TimeOutValue > 0 Then
- If lStart + TimeOutValue < 86400 Then
- lTimeToQuit = lStart + TimeOutValue
- Else
- lTimeToQuit = (lStart - 86400) + TimeOutValue
- bPastMidnight = True
- End If
- End If
- lInst = Shell(sExeName, vbMinimizedNoFocus)
- lProcessId = 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 = STATUS_PENDING
- ShellandWait = True
- ErrorHandler:
- ShellandWait = False
- Exit Function
- End Function
- Function FTP_CODE()
- Dim FTP_SCR As String
- FTP_SCR = "C:\DLU\SYSTEM\FTP\TEST.scr"
- Call ShellandWait("ftp.exe -s:" & FTP_SCR, 1000000)
- MsgBox "Process Completed"
- Kill "C:\DLU\SYSTEM\FTP\TEST.txt"
- End Function