Bat file returns running status in VBA

[sophannaly]

Hi,

Could anybody tell me how to get returning code(success or fail) from the following code so I can know what should I do in my VBA. What can I do now is show message from bat file, but I don't know how to get it running status and pass it to VBA. This post is original from NeoPa.

Option Compare Database
 Option Explicit
 
 'Windows API Variable Prefixes
 'cb = Count of Bytes (32-bit)
 'w  = Word (16-bit)
 'dw = Double Word (32-bit)
 'lp = Long Pointer (32-bit)
 'b  = Boolean (32-bit)
 'h  = Handle (32-bit)
 'ul = Unsigned Long (32-bit)
 
 Private Const conUseShowWindow = &H1&
 Private Const conNormalPriority = &H20&
 Private Const conInfinite = -1&
 
 Private Type typStartupInfo
     cbLen As Long
     lpReserved As String
     lpDesktop As String
     lpTitle As String
     dwX As Long
     dwY As Long
     dwXSize As Long
     dwYSize As Long
     dwXCount As Long
     dwYCount As Long
     dwFillAtt As Long
     dwFlags As Long
     wShowWindow As Integer
     cbReserved2 As Integer
     lpReserved2 As Long
     hStdIn As Long
     hStdOut As Long
     hStdErr As Long
 End Type
 
 Private Type typProcInfo
     hProc As Long
     hThread As Long
     dwProcID As Long
     dwThreadID As Long
 End Type
 
 Private Declare Function CreateProcessA Lib "kernel32" ( _
     ByVal lpApplicationName As Long, _
     ByVal lpCommandLine As String, _
     ByVal lpProcessAttributes As Long, _
     ByVal lpThreadAttributes As Long, _
     ByVal bInheritHandles As Long, _
     ByVal dwCreationFlags As Long, _
     ByVal lpEnvironment As Long, _
     ByVal lpCurrentDirectory As Long, _
     lpStartupInfo As typStartupInfo, _
     lpProcessInformation As typProcInfo) As Long
 Private Declare Function WaitForSingleObject Lib "kernel32" ( _
     ByVal hHandle As Long, _
     ByVal dwMilliseconds As Long) As Long
 Private Declare Function CloseHandle Lib "kernel32" ( _
     ByVal hObject As Long) As Long
 
 'ShellWait() executes a command synchronously (Shell() works asynchronously).
 Public Sub ShellWait(strCommand As String, _
                      Optional intWinStyle As Integer = vbNormalFocus)
     Dim objProcInfo As typProcInfo
     Dim objStart As typStartupInfo
 
     'Initialize the typStartupInfo structure:
     With objStart
         .cbLen = Len(objStart)
         .dwFlags = conUseShowWindow
         .wShowWindow = intWinStyle
     End With
     'Start the shelled application:
     Call CreateProcessA(lpApplicationName:=0&, _
                         lpCommandLine:=strCommand, _
                         lpProcessAttributes:=0&, _
                         lpThreadAttributes:=0&, _
                         bInheritHandles:=1&, _
                         dwCreationFlags:=conNormalPriority, _
                         lpEnvironment:=0&, _
                         lpCurrentDirectory:=0&, _
                         lpStartupInfo:=objStart, _
                         lpProcessInformation:=objProcInfo)
     'Wait for the shelled application to finish
     Call WaitForSingleObject(hHandle:=objProcInfo.hProc, _
                              dwMilliseconds:=conInfinite)
     Call CloseHandle(hObject:=objProcInfo.hProc)
 End Sub

Could anybody point me on how to do this?

Best regards,
Sophanna

[NeoPa]

Good question Sophanna. Not an easy one though :-(

Though it surprises me somewhat, I see nothing that refers to any return code from the available information.

Let me explain as far as I can :
The only parameter I see there that might be used for returning information would be the one called objProcInfo (which is of type typProcInfo as declared from lines #38 to #43. Nothing in there pertains to a return code as far as I can see.

Another issue that may cloud things for BAT or CMD files particularly, is that they are not executed directly by Windows itself. The are interpreted and executed by the command line processor. BAT files are processed by the old DOS compatible Command.com and CMD files are processed by Windows' own CMD.exe. Thus, I would expect the return code is only available to any processes executing within that same environment (IE. Command.com for BAT files and CMD.exe for CMD files).

I'd be interested to here from anyone else who may be able to throw any light on this one. It's not impossible there is a way, but if it exists at all then I would expect it's a bit obscure.

@Sophanna.
If this is important to your project you could save it from the BAT file itself into a specifically named file for checking by your project. If it's simply necessary to know if it failed or not then the following code at the end of your BAT file should do it (I'm assuming the current folder is an adequate place to save the file) :

...
DEL Status.Txt
{Your program whose status you want to capture runs here}
IF ERRORLEVEL 1 ECHO Failed >Status.Txt

If the file exists after the process has completed then the program failed. I hope this is helpful.

[Hennepin]

If the function CreateProcessA succeeds, the return value is nonzero.
If the function fails, the return value is zero. To get extended error information, call GetLastError.

I have code that dumps the ouput of a command into a string, which I could post if you want.

'Start the shelled application:
if CreateProcessA(lpApplicationName:=0&, _
						lpCommandLine:=strCommand, _
						lpProcessAttributes:=0&, _
						lpThreadAttributes:=0&, _
						bInheritHandles:=1&, _
						dwCreationFlags:=conNormalPriority, _
						lpEnvironment:=0&, _
						lpCurrentDirectory:=0&, _
						lpStartupInfo:=objStart, _
						lpProcessInformation:=objProcInfo)
	'Wait for the shelled application to finish
	Call WaitForSingleObject(hHandle:=objProcInfo.hProc,  dwMilliseconds:=conInfinite)
else
		'failed
end if

[sophannaly]

Hi NeoPa,

Thanks you so much for your reply. Since I can't get what I want from that code but you had give me idea on generating something else which I also can evaluate its running status.

Best regards,
Sophanna

[sophannaly]

Hi Hennepin,

Could you show me the whole code please?

Best regards,
Sophanna

[NeoPa]

Interesting ideas Hennepin.

Unfortunately, there are problems with both :

1. The return value of CreateProcessA is determined before the BAT file actually runs. Whatever it returns would not be relevant to what ran within the BAT file.
2. Once the process has completed the thread no longer exists. I would expect GetLastError() to return a value relevant to the Access VBA thread that called it rather than being able to reference a separate thread which no longer exists.

As I mentioned earlier (though I can't be absolutely sure about it) I suspect that determining the return value after the whole process has completed will prove impossible.

Please don't let this put you off though. I was very interested to see you'd posted and it certainly gave me something to think about and check up on :-)

[sophannaly]

Hi NeoPa,

May I explain you about what am I trying to do, so maybe you could give me some ideas about this. I use access as front end database. And I design Talend Open Studio ETL job and build it as job script(bat file) which about deploying data from front end to back end database. Before calling this ETL job script, in VBA I have update query(such as change field from 0 to 1) then call this bat file to run.

During running job script, maybe there is an error such as back end database service is closed, then job run fail, there is a message about error to show user. So in my VBA needs to know that this job is fail, so I should use another update query(to change that field from 1 to 0).

Could you provide some ideas about this?

Best regards,
Sophanna

[Hennepin]

NeoPa
I realized both of your points as I was going home from work last night.
I will fail if it can't run the bat file but will not report what the bat file returns.
The code below will return the ouput of the bat file.
Been using it for about 10 years in VB6 and VBA.

sophannaly
The code below will return any screen dump to the cmd window in a string.

Option Explicit
''''''''''''''''''''''''''''''''''''''''
' Joacim Andersson, Brixoft Software
' http://www.brixoft.net
''''''''''''''''''''''''''''''''''''''''

' STARTUPINFO flags
Private Const STARTF_USESHOWWINDOW = &H1
Private Const STARTF_USESTDHANDLES = &H100

' ShowWindow flags
Private Const SW_HIDE = 0

' DuplicateHandle flags
Private Const DUPLICATE_CLOSE_SOURCE = &H1
Private Const DUPLICATE_SAME_ACCESS = &H2

' Error codes
Private Const ERROR_BROKEN_PIPE = 109

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadID As Long
End Type

Private Declare Function CreatePipe _
 Lib "kernel32" ( _
 phReadPipe As Long, _
 phWritePipe As Long, _
 lpPipeAttributes As Any, _
 ByVal nSize As Long) As Long

Private Declare Function ReadFile _
 Lib "kernel32" ( _
 ByVal hFile As Long, _
 lpBuffer As Any, _
 ByVal nNumberOfBytesToRead As Long, _
 lpNumberOfBytesRead As Long, _
 lpOverlapped As Any) As Long

Private Declare Function CreateProcess _
 Lib "kernel32" Alias "CreateProcessA" ( _
 ByVal lpApplicationName As String, _
 ByVal lpCommandLine As String, _
 lpProcessAttributes As Any, _
 lpThreadAttributes As Any, _
 ByVal bInheritHandles As Long, _
 ByVal dwCreationFlags As Long, _
 lpEnvironment As Any, _
 ByVal lpCurrentDriectory As String, _
 lpStartupInfo As STARTUPINFO, _
 lpProcessInformation As PROCESS_INFORMATION) As Long

Private Declare Function GetCurrentProcess _
 Lib "kernel32" () As Long

Private Declare Function DuplicateHandle _
 Lib "kernel32" ( _
 ByVal hSourceProcessHandle As Long, _
 ByVal hSourceHandle As Long, _
 ByVal hTargetProcessHandle As Long, _
 lpTargetHandle As Long, _
 ByVal dwDesiredAccess As Long, _
 ByVal bInheritHandle As Long, _
 ByVal dwOptions As Long) As Long

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

Private Declare Function OemToCharBuff _
 Lib "user32" Alias "OemToCharBuffA" ( _
 lpszSrc As Any, _
 ByVal lpszDst As String, _
 ByVal cchDstLength As Long) As Long

' Function GetCommandOutput
'
' sCommandLine:  [in] Command line to launch
' blnStdOut        [in,opt] True (defualt) to capture output to STDOUT
' blnStdErr        [in,opt] True to capture output to STDERR. False is default.
' blnOEMConvert:   [in,opt] True (default) to convert DOS characters to Windows, False to skip conversion
'
' Returns:       String with STDOUT and/or STDERR output
'
Public Function GetCommandOutput( _
 sCommandLine As String, _
 Optional blnStdOut As Boolean = True, _
 Optional blnStdErr As Boolean = False, _
 Optional blnOEMConvert As Boolean = True _
) As String

    Dim hPipeRead As Long, hPipeWrite1 As Long, hPipeWrite2 As Long
    Dim hCurProcess As Long
    Dim sa As SECURITY_ATTRIBUTES
    Dim si As STARTUPINFO
    Dim pi As PROCESS_INFORMATION
    Dim baOutput() As Byte
    Dim sNewOutput As String
    Dim lBytesRead As Long
    Dim fTwoHandles As Boolean

    Dim lRet As Long

    Const BUFSIZE = 1024      ' pipe buffer size

    ' At least one of them should be True, otherwise there's no point in calling the function
    If (Not blnStdOut) And (Not blnStdErr) Then
        Err.Raise 5         ' Invalid Procedure call or Argument
    End If

    ' If both are true, we need two write handles. If not, one is enough.
    fTwoHandles = blnStdOut And blnStdErr

    ReDim baOutput(BUFSIZE - 1) As Byte

    With sa
        .nLength = Len(sa)
        .bInheritHandle = 1    ' get inheritable pipe handles
    End With

    If CreatePipe(hPipeRead, hPipeWrite1, sa, BUFSIZE) = 0 Then
        Exit Function
    End If

    hCurProcess = GetCurrentProcess()

    ' Replace our inheritable read handle with an non-inheritable. Not that it
    ' seems to be necessary in this case, but the docs say we should.
    Call DuplicateHandle(hCurProcess, hPipeRead, hCurProcess, hPipeRead, 0&, 0&, DUPLICATE_SAME_ACCESS Or DUPLICATE_CLOSE_SOURCE)

    ' If both STDOUT and STDERR should be redirected, get an extra handle.
    If fTwoHandles Then
        Call DuplicateHandle(hCurProcess, hPipeWrite1, hCurProcess, hPipeWrite2, 0&, 1&, DUPLICATE_SAME_ACCESS)
    End If

    With si
        .cb = Len(si)
        .dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
        .wShowWindow = SW_HIDE          ' hide the window

        If fTwoHandles Then
            .hStdOutput = hPipeWrite1
            .hStdError = hPipeWrite2
        ElseIf blnStdOut Then
            .hStdOutput = hPipeWrite1
        Else
            .hStdError = hPipeWrite1
        End If
    End With

    If CreateProcess(vbNullString, sCommandLine, ByVal 0&, ByVal 0&, 1, 0&, ByVal 0&, vbNullString, si, pi) Then

        ' Close thread handle - we don't need it
        Call CloseHandle(pi.hThread)

        ' Also close our handle(s) to the write end of the pipe. This is important, since
        ' ReadFile will *not* return until all write handles are closed or the buffer is full.
        Call CloseHandle(hPipeWrite1)
        hPipeWrite1 = 0
        If hPipeWrite2 Then
            Call CloseHandle(hPipeWrite2)
            hPipeWrite2 = 0
        End If

        Do
            ' Add a DoEvents to allow more data to be written to the buffer for each call.
            ' This results in fewer, larger chunks to be read.
            'DoEvents

            If ReadFile(hPipeRead, baOutput(0), BUFSIZE, lBytesRead, ByVal 0&) = 0 Then
                Exit Do
            End If

            If blnOEMConvert Then
                ' convert from "DOS" to "Windows" characters
                sNewOutput = String$(lBytesRead, 0)
                Call OemToCharBuff(baOutput(0), sNewOutput, lBytesRead)
            Else
                ' perform no conversion (except to Unicode)
                sNewOutput = left$(StrConv(baOutput(), vbUnicode), lBytesRead)
            End If

            GetCommandOutput = GetCommandOutput & sNewOutput

            ' If you are executing an application that outputs data during a long time,
            ' and don't want to lock up your application, it might be a better idea to
            ' wrap this code in a class module in an ActiveX EXE and execute it asynchronously.
            ' Then you can raise an event here each time more data is available.
            'RaiseEvent OutputAvailabele(sNewOutput)
        Loop

        ' When the process terminates successfully, Err.LastDllError will be
        ' ERROR_BROKEN_PIPE (109). Other values indicates an error.

        Call CloseHandle(pi.hProcess)
    Else
        GetCommandOutput = "Failed to create process, check the path of the command line."
    End If

    ' clean up
    Call CloseHandle(hPipeRead)
    If hPipeWrite1 Then
        Call CloseHandle(hPipeWrite1)
    End If
    If hPipeWrite2 Then
        Call CloseHandle(hPipeWrite2)
    End If
End Function

[NeoPa]

At 238 lines I think I'll take your word for it ;-)

@Sophanna.
I would give that code a try and let us know how you get on. I'm not sure exactly how you'd use it in your project but I would expect it to be easy to determine (as no instructions have been included with it). If you struggle I'm sure Hennepin will be happy to point you in the right direction if you ask them nicely.

[sophannaly]

Hi Hennepin,

Thanks your for your code but I got stuck on how to use this code. Is it right to call this function like this:

FileName = CurrentProject.Path & "\Request_Budget_Expenditure\Request_Budget_Expenditure_run.bat"
            
            Error_Code = GetCommandOutput(FileName)
            MsgBox Error_Code

Error_Code is String type. and your code I Save it as module. I didn't see it calls bat file to run.

Best regard,
Sophanna

[Hennepin]

In my project I am just reading the dump of license status from an executable. If it fails I have an empty string. So i know it failed.

I am assuming in your case the bat file does not return anything. So if it fails you need to have the std error returned so the optional blnStdErr needs to be true.

FileName = CurrentProject.Path & "\Request_Budget_Expenditure\Request_Budget_Expenditure_run.bat"
Error_Code = GetCommandOutput(sCommandLine:=FileName, blnStdErr:=True)
MsgBox Error_Code

I tested this with a simple bat file that was bad.

    Debug.Print "----bad---"
    s = GetCommandOutput(sCommandLine:="c:\mystuff\bad.bat", blnStdErr:=False)    
    Debug.Print s
    s = GetCommandOutput(sCommandLine:="c:\mystuff\bad.bat", blnStdErr:=True) 'dir C:\MyStuf\*.pdf /b
    Debug.Print "---bad-with stderr---"
    Debug.Print s

This is the output. It has the error in the second line of return string.

----bad---

C:\MyStuff\acdata>dir C:\MyStuf\*.pdf /b 

---bad-with stderr---

C:\MyStuff\acdata>dir C:\MyStuf\*.pdf /b 
The system cannot find the file specified.

[sophannaly]

Hi Hennepin,
I solved my problem by doing this update with ETL job. Anyway, thanks you so much for your reply and help. I will test it next time.

Best regards,
Sophanna