Excel VBA ShellandWait on Win 7 64 Bit RRS feed

  • Question

  • I am testing the following code but I can't get it to work

    I am using Office 2010 (32bit) on Win 7 Pro 64 bit.

    It runs fine on 32bit Win XP wiht Office 2007. I'm sure it's not an Office 2010 issue and suspect it is to do with 64bit Windows.

    I found some posts that suggested changing the declarations from

    Private Declare Function XXX Lib "kernel32"


    Private PtrSafe Declare Function XXX Lib "kernel32"

    but I think this is only for compatibiklity to Office 64bit

    Any Ideas. I get an error at the line

    TaskID = Shell(ShellCommand, ShellWindowState)

    The ShellCOmmand is correct for 32bit windows so I know it is not an error on the command syntax in general, only a 32 /64 bit Windows issue.

    Also, I can't see replacement Kernels for 64bit win for the ones i use

    It's hard to debug as I just get error number 5 on the offending line. i.e. that is the value of Err 

    Many thanks in advance.


    Option Explicit
    Option Compare Text

    ' modShellAndWait
    ' By Chip Pearson,,
    ' This page on the web site:
    ' 9-September-2008
    ' This module contains code for the ShellAndWait function that will Shell to a process
    ' and wait for that process to end before returning to the caller.
    Private Declare Function WaitForSingleObject Lib "kernel32" ( _
        ByVal hHandle As Long, _
        ByVal dwMilliseconds As Long) As Long

    Private Declare Function OpenProcess Lib "kernel32.dll" ( _
        ByVal dwDesiredAccess As Long, _
        ByVal bInheritHandle As Long, _
        ByVal dwProcessId As Long) As Long

    Private Declare Function CloseHandle Lib "kernel32" ( _
        ByVal hObject As Long) As Long

    Private Const SYNCHRONIZE = &H100000

    Public Enum ShellAndWaitResult
        Success = 0
        Failure = 1
        TimeOut = 2
        InvalidParameter = 3
        SysWaitAbandoned = 4
        UserWaitAbandoned = 5
        UserBreak = 6
    End Enum

    Public Enum ActionOnBreak
        IgnoreBreak = 0
        AbandonWait = 1
        PromptUser = 2
    End Enum

    Private Const STATUS_ABANDONED_WAIT_0 As Long = &H80
    Private Const STATUS_WAIT_0 As Long = &H0
    Private Const WAIT_ABANDONED As Long = (STATUS_ABANDONED_WAIT_0 + 0)
    Private Const WAIT_OBJECT_0 As Long = (STATUS_WAIT_0 + 0)
    Private Const WAIT_TIMEOUT As Long = 258&
    Private Const WAIT_FAILED As Long = &HFFFFFFFF
    Private Const WAIT_INFINITE = -1&

    Public Function ShellAndWait(ShellCommand As String, _
                        TimeOutMs As Long, _
                        ShellWindowState As VbAppWinStyle, _
                        BreakKey As ActionOnBreak) As ShellAndWaitResult
    ' ShellAndWait
    ' This function calls Shell and passes to it the command text in ShellCommand. The function
    ' then waits for TimeOutMs (in milliseconds) to expire.
    '   Parameters:
    '       ShellCommand
    '           is the command text to pass to the Shell function.
    '       TimeOutMs
    '           is the number of milliseconds to wait for the shell'd program to wait. If the
    '           shell'd program terminates before TimeOutMs has expired, the function returns
    '           ShellAndWaitResult.Success = 0. If TimeOutMs expires before the shell'd program
    '           terminates, the return value is ShellAndWaitResult.TimeOut = 2.
    '       ShellWindowState
    '           is an item in VbAppWinStyle specifying the window state for the shell'd program.
    '       BreakKey
    '           is an item in ActionOnBreak indicating how to handle the application's cancel key
    '           (Ctrl Break). If BreakKey is ActionOnBreak.AbandonWait and the user cancels, the
    '           wait is abandoned and the result is ShellAndWaitResult.UserWaitAbandoned = 5.
    '           If BreakKey is ActionOnBreak.IgnoreBreak, the cancel key is ignored. If
    '           BreakKey is ActionOnBreak.PromptUser, the user is given a ?Continue? message. If the
    '           user selects "do not continue", the function returns ShellAndWaitResult.UserBreak = 6.
    '           If the user selects "continue", the wait is continued.
    '   Return values:
    '            ShellAndWaitResult.Success = 0
    '               indicates the the process completed successfully.
    '            ShellAndWaitResult.Failure = 1
    '               indicates that the Wait operation failed due to a Windows error.
    '            ShellAndWaitResult.TimeOut = 2
    '               indicates that the TimeOutMs interval timed out the Wait.
    '            ShellAndWaitResult.InvalidParameter = 3
    '               indicates that an invalid value was passed to the procedure.
    '            ShellAndWaitResult.SysWaitAbandoned = 4
    '               indicates that the system abandoned the wait.
    '            ShellAndWaitResult.UserWaitAbandoned = 5
    '               indicates that the user abandoned the wait via the cancel key (Ctrl+Break).
    '               This happens only if BreakKey is set to ActionOnBreak.AbandonWait.
    '            ShellAndWaitResult.UserBreak = 6
    '               indicates that the user broke out of the wait after being prompted with
    '               a ?Continue message. This happens only if BreakKey is set to
    '               ActionOnBreak.PromptUser.


    Dim TaskID As Long
    Dim ProcHandle As Long
    Dim WaitRes As Long
    Dim Ms As Long
    Dim MsgRes As VbMsgBoxResult
    Dim SaveCancelKey As XlEnableCancelKey
    Dim ElapsedTime As Long
    Dim Quit As Boolean
    Const ERR_BREAK_KEY = 18

    If Trim(ShellCommand) = vbNullString Then
        ShellAndWait = ShellAndWaitResult.InvalidParameter
        Exit Function
    End If

    If TimeOutMs < 0 Then
        ShellAndWait = ShellAndWaitResult.InvalidParameter
        Exit Function
    ElseIf TimeOutMs = 0 Then
        Ms = WAIT_INFINITE
        Ms = TimeOutMs
    End If

    Select Case BreakKey
        Case AbandonWait, IgnoreBreak, PromptUser
            ' valid
        Case Else
            ShellAndWait = ShellAndWaitResult.InvalidParameter
            Exit Function
    End Select

    Select Case ShellWindowState
        Case vbHide, vbMaximizedFocus, vbMinimizedFocus, vbMinimizedNoFocus, vbNormalFocus, vbNormalNoFocus
            ' valid
        Case Else
            ShellAndWait = ShellAndWaitResult.InvalidParameter
            Exit Function
    End Select

    On Error Resume Next
    TaskID = Shell(ShellCommand, ShellWindowState)
    If (Err.Number <> 0) Or (TaskID = 0) Then
        ShellAndWait = ShellAndWaitResult.Failure
        Exit Function
    End If

    ProcHandle = OpenProcess(SYNCHRONIZE, False, TaskID)
    If ProcHandle = 0 Then
        ShellAndWait = ShellAndWaitResult.Failure
        Exit Function
    End If

    On Error GoTo ErrH:
    SaveCancelKey = Application.EnableCancelKey
    Application.EnableCancelKey = xlErrorHandler
    WaitRes = WaitForSingleObject(ProcHandle, DEFAULT_POLL_INTERVAL)
    Do Until WaitRes = WAIT_OBJECT_0
        Select Case WaitRes
            Case WAIT_ABANDONED
                ' Windows abandoned the wait
                ShellAndWait = ShellAndWaitResult.SysWaitAbandoned
                Exit Do
            Case WAIT_OBJECT_0
                ' Successful completion
                ShellAndWait = ShellAndWaitResult.Success
                Exit Do
            Case WAIT_FAILED
                ' attach failed
                ShellAndWait = ShellAndWaitResult.Success
                Exit Do
            Case WAIT_TIMEOUT
                ' Wait timed out. Here, this time out is on DEFAULT_POLL_INTERVAL.
                ' See if ElapsedTime is greater than the user specified wait
                ' time out. If we have exceed that, get out with a TimeOut status.
                ' Otherwise, reissue as wait and continue.
                ElapsedTime = ElapsedTime + DEFAULT_POLL_INTERVAL
                If Ms > 0 Then
                    ' user specified timeout
                    If ElapsedTime > Ms Then
                        ShellAndWait = ShellAndWaitResult.TimeOut
                        Exit Do
                        ' user defined timeout has not expired.
                    End If
                    ' infinite wait -- do nothing
                End If
                ' reissue the Wait on ProcHandle
                WaitRes = WaitForSingleObject(ProcHandle, DEFAULT_POLL_INTERVAL)
            Case Else
                ' unknown result, assume failure
                ShellAndWait = ShellAndWaitResult.Failure
                Quit = True
        End Select

    CloseHandle ProcHandle
    Application.EnableCancelKey = SaveCancelKey
    Exit Function

    Debug.Print "ErrH: Cancel: " & Application.EnableCancelKey
    If Err.Number = ERR_BREAK_KEY Then
        If BreakKey = ActionOnBreak.AbandonWait Then
            CloseHandle ProcHandle
            ShellAndWait = ShellAndWaitResult.UserWaitAbandoned
            Application.EnableCancelKey = SaveCancelKey
            Exit Function
        ElseIf BreakKey = ActionOnBreak.IgnoreBreak Then
        ElseIf BreakKey = ActionOnBreak.PromptUser Then
            MsgRes = MsgBox("User Process Break." & vbCrLf & _
                "Continue to wait?", vbYesNo)
            If MsgRes = vbNo Then
                CloseHandle ProcHandle
                ShellAndWait = ShellAndWaitResult.UserBreak
                Application.EnableCancelKey = SaveCancelKey
                Resume Next
            End If
            'Debug.Print "Unknown value of 'BreakKey': " & CStr(BreakKey)
            CloseHandle ProcHandle
            Application.EnableCancelKey = SaveCancelKey
            ShellAndWait = ShellAndWaitResult.Failure
        End If
        ' some other error. assume failure
        CloseHandle ProcHandle
        ShellAndWait = ShellAndWaitResult.Failure
    End If

    Application.EnableCancelKey = SaveCancelKey

    End Function

    Tuesday, November 27, 2012 11:31 AM

All replies

  • Hi jmac88,

    Thanks for posting in the MSDN Forum.

    I tried that code. It works fine on my side (Office 2010 32-bit, Win8 64-bit). It's based on my experience that issue regard the commend line content and the parameters of the ShellandWait Fuction. Would you please provide your command line content and TimeOutMs, ShellWindowState, BreakKey for further research?

    Have a good day,


    Tom Xu [MSFT]
    MSDN Community Support | Feedback to us

    Wednesday, November 28, 2012 2:34 AM
  • Thanks

    Code below. Tested on Win8 but not Win 7.

    I will move out all the parameters later once I have it working into an Excel Sheet

    I am using this to all the ioservice for Imagine Software and the command it based on  their sample files and it all works fine on xp 32 bit with office 2007. It also works if I call the ioservice via a bat file. i.e. just double click the bat file so I know all works with Win7 64 bit

    Can't give the username and pw so not sure how you can test it. But maybe this will show something. I will test it on a  simple bat file instead and see what happens.

    '*********************** TEST *************************

    Private Sub pTest()
        Dim sUserName As String, sPassword As String
        Dim sService As String
        Dim sInpFileSuffix As String, sOutFileSuffix As String, sLogFileSuffix As String
        Dim sInpFile As String, sOutFile As String, sLogFile As String
        Dim sDirectory As String, sIOService As String
        Dim sCommand As String
        Dim sDirectory As String, sLogs As String, sInput As String, sOutput As String
        Dim sLogsPath As String, sInputPath As String, sOutputPath As String
        Dim vResult As Integer

        sUserName = "XXX"
        sPassword = "XXX"
        sService = "downloadPortfolio"
        sInpFileSuffix = "_inp.csv"
        sOutFileSuffix = "_out.txt"
        sLogFileSuffix = "_log.txt"

        sDirectory = "C:\Program Files (x86)\Imagine Software\its\Bin"
    '    sDirectory = "C:\Program Files\Imagine Software\its\Bin\"
        sIOService = "IOServiceClient.exe"

        sInpFile = sService & sInpFileSuffix
        sOutFile = sService & sOutFileSuffix
        sLogFile = sService & sLogFileSuffix

        sDirectory = "V:\Imagine"
        sLogs = "Logs"
        sInput = "Input"
        sOutput = "Output"
        sLogsPath = sDirectory & "\" & sLogs & "\"
        sInputPath = sDirectory & "\" & sInput & "\"
        sOutputPath = sDirectory & "\" & sOutput & "\"

        sCommand = sDirectory & sIOService & " -u " & sUserName & " -p " & sPassword & " -f " & sInputPath & sInpFile & " -o " & sOutputPath & sOutFile & " -ios " & sService & " -log " & sLogsPath & sLogFile & " -d ,"
        vResult = ShellAndWait(sCommand, 300000, vbHide, PromptUser)
        MsgBox vResult

    End Sub

    Wednesday, November 28, 2012 7:29 AM