# Excel VBA Run External Program and Capture output VBA7 WIN64



## shamsian (Dec 12, 2018)

Running  EXCEL 2016 16.0.9126.2282 64-bit on Windows 10

I have an Excel App that uses VBA to run external program and capture the output and it worked fine on Excel 32-bit.  
I had to update the program to work with Win64/VBA7 but now the call to GetStartupInfo crashes Excel.
I have tried everything but cannot find out why Excel is crashing.  
I created a small app to show the problem. 
 Create a Module and paste the code below.  
Execute the RunProcess subroutine and Excel will crash on the line "GetStartupInfo tStartupInfo"

Any help is greatly appreciated.


```
Option Explicit


Private Const WAIT_INFINITE         As Long = (-1&)
Private Const STARTF_USESHOWWINDOW  As Long = &H1
Private Const STARTF_USESTDHANDLES  As Long = &H100
Private Const SW_HIDE               As Long = 0&
Private Const SW_SHOWNORMAL         As Long = 1&


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




Type PROCESS_INFORMATION
        hProcess As LongPtr
        hThread As LongPtr
        dwProcessId As Long
        dwThreadId As Long
End Type




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 LongPtr
        hStdInput As LongPtr
        hStdOutput As LongPtr
        hStdError As LongPtr
End Type


Private Declare PtrSafe Function CreatePipe Lib "kernel32" (phReadPipe As LongPtr, phWritePipe As LongPtr, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
Private Declare PtrSafe Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, 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 PtrSafe Function ReadFile Lib "kernel32" (ByVal hFile As LongPtr, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As LongPtr, ByVal dwMilliseconds As Long) As Long
Private Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As LongPtr, lpExitCode As Long) As Long
Private Declare PtrSafe Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoA" (ByRef lpStartupInfo As STARTUPINFO)
Private Declare PtrSafe Function GetFileSize Lib "kernel32" (ByVal hFile As LongPtr, lpFileSizeHigh As Long) As Long


Sub RunProcess()




Dim tSA_CreatePipe              As SECURITY_ATTRIBUTES
Dim tSA_CreateProcessPrc        As SECURITY_ATTRIBUTES
Dim tSA_CreateProcessThrd       As SECURITY_ATTRIBUTES
Dim tSA_CreateProcessPrcInfo    As PROCESS_INFORMATION
Dim tStartupInfo                As STARTUPINFO
Dim bRead                       As Long
Dim abytBuff()                  As Byte
Dim lngResult                   As Long
Dim szFullCommand               As String
Dim lngExitCode                 As Long
Dim lngSizeOf                   As Long
Dim msg                         As String


Dim hRead                       As LongPtr
Dim hWrite                      As LongPtr




tSA_CreatePipe.nLength = Len(tSA_CreatePipe)
tSA_CreatePipe.lpSecurityDescriptor = 0&
tSA_CreatePipe.bInheritHandle = True


tSA_CreateProcessPrc.nLength = Len(tSA_CreateProcessPrc)
tSA_CreateProcessThrd.nLength = Len(tSA_CreateProcessThrd)


If (CreatePipe(hRead, hWrite, tSA_CreatePipe, 0&) <> 0&) Then


    With tStartupInfo
        .cb = LenB(tStartupInfo)
        .lpReserved = vbNullString
        .cbReserved2 = 0
        .lpReserved2 = 0&
    End With
   
    GetStartupInfo tStartupInfo


    With tStartupInfo
        .hStdOutput = hWrite
        .hStdError = hWrite
        ' .dwFlags = STARTF_USESTDHANDLES
        .dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
        .wShowWindow = SW_HIDE
    End With
    
    szFullCommand = "cmd.exe /C dir"


    lngResult = CreateProcess(0&, szFullCommand, tSA_CreateProcessPrc, tSA_CreateProcessThrd, True, 0&, ByVal 0&, vbNullString, tStartupInfo, tSA_CreateProcessPrcInfo)


    If (lngResult <> 0&) Then
        lngResult = WaitForSingleObject(tSA_CreateProcessPrcInfo.hProcess, 10000) ' for this test program wait 1 Sec instead of WAIT_INFINITE 
        lngSizeOf = GetFileSize(hRead, 0&)
        If (lngSizeOf > 0) Then
            ReDim abytBuff(lngSizeOf - 1)
            If ReadFile(hRead, abytBuff(0), UBound(abytBuff) + 1, bRead, ByVal 0&) Then
                msg = StrConv(abytBuff, vbUnicode)
            End If
        End If
        Call GetExitCodeProcess(tSA_CreateProcessPrcInfo.hProcess, lngExitCode)
        CloseHandle tSA_CreateProcessPrcInfo.hThread
        CloseHandle tSA_CreateProcessPrcInfo.hProcess
                
        If (lngExitCode <> 0&) Then
            Debug.Print "Success"
            Debug.Print msg
        End If
        
        CloseHandle hWrite
        CloseHandle hRead
    Else
        Debug.Print "CreateProcess Failed, Code: " & Err.LastDllError
    End If
End If




End Sub
```


----------



## Kenneth Hobson (Dec 12, 2018)

Welcome to the forum!

Some will need PtrSafe for the 64 bit APIs. This site has some good examples. https://www.jkp-ads.com/articles/apideclarations.asp


----------

