33

Found this function on http://www.cpearson.com/excel/ShellAndWait.aspx

But I would also need to capture the output from the shell. Any code suggestion?

Option Explicit
Option Compare Text

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modShellAndWait
' By Chip Pearson, chip@cpearson.com, www.cpearson.com
' This page on the web site: www.cpearson.com/Excel/ShellAndWait.aspx
' 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
Const DEFAULT_POLL_INTERVAL = 500

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
Else
    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
Err.Clear
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
    DoEvents
    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.Failure
            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
                Else
                    ' user defined timeout has not expired.
                End If
            Else
                ' 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
            Exit Do
            Quit = True
    End Select
Loop

CloseHandle ProcHandle
Application.EnableCancelKey = SaveCancelKey
Exit Function

ErrH:
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
        Err.Clear
        Resume
    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
        Else
            Err.Clear
            Resume Next
        End If
    Else
        CloseHandle ProcHandle
        Application.EnableCancelKey = SaveCancelKey
        ShellAndWait = ShellAndWaitResult.Failure
    End If
Else
    ' some other error. assume failure
    CloseHandle ProcHandle
    ShellAndWait = ShellAndWaitResult.Failure
End If

Application.EnableCancelKey = SaveCancelKey

End Function
ZygD
  • 8,011
  • 21
  • 49
  • 67
user310291
  • 33,174
  • 71
  • 241
  • 439

7 Answers7

63

Based on Andrew Lessard's answer, here's a function to run a command and return the output as a string -

Public Function ShellRun(sCmd As String) As String

    'Run a shell command, returning the output as a string

    Dim oShell As Object
    Set oShell = CreateObject("WScript.Shell")

    'run command
    Dim oExec As Object
    Dim oOutput As Object
    Set oExec = oShell.Exec(sCmd)
    Set oOutput = oExec.StdOut

    'handle the results as they are written to and read from the StdOut object
    Dim s As String
    Dim sLine As String
    While Not oOutput.AtEndOfStream
        sLine = oOutput.ReadLine
        If sLine <> "" Then s = s & sLine & vbCrLf
    Wend

    ShellRun = s

End Function

Usage:

MsgBox ShellRun("dir c:\")
Brian Burns
  • 14,953
  • 5
  • 69
  • 59
  • 1
    I credited this great answer of yours on a recent [Python post](http://stackoverflow.com/questions/39516875/return-result-from-python-to-vba/39517658#39517658). Feel free to answer it directly and I will delete my own. – Parfait Sep 15 '16 at 18:11
  • 8
    I couldn't get this to work using your example. I needed `ShellRun("cmd.exe /c dir c:\")` instead. Then it worked perfectly. Thank you. – mal Sep 16 '16 at 03:21
  • 13
    you don't need the while loop here, you can replace from the line `Set oOutput = oExec.StdOut` until the end of the function with this line: `ShellRun = oExec.StdOut.ReadAll` – Pupa Rebbe Jun 06 '17 at 20:02
  • 4
    Also if you need individual lines then you can `ShellRun = Split(oExec.StdOut.ReadAll, vbCrLf)`, and change the function declaration to `Public Function ShellRun(sCmd As String) As String()`. This gives a 0 indexed array of strings. – Greedo Aug 15 '17 at 17:15
  • Thanks for this - I've been scratching by brain for hours trying to find a solution to get the return from a powershell command. Is there anyway to change the Shell so that it is hidden from view? – Tom Jan 11 '18 at 10:15
21

You can CreateProcess the application redirecting its StdOut to a pipe, then read that pipe directly; http://pastebin.com/CszKUpNS

dim resp as string 
resp = redirect("cmd","/c dir")
resp = redirect("ipconfig","")
Alex K.
  • 159,548
  • 29
  • 245
  • 267
  • Sorry, but how did you get your code to run? I am trying to do something similar (pull stdout data in to VBA, and I am running on OSX) and I am not sure where to declare your functions. I tried putting them in the same folder that defines the functionality of my user forms when they click submit, but it gave me an error stating "Compile Error: Only comments may appear after End Sub, End Function, or End Property". – Engineero Jun 12 '13 at 01:51
  • 1
    This is Windows specific code as it uses the Windows API; it wont run on OSX no matter what you do - better to ask a new question. – Alex K. Jun 12 '13 at 10:11
  • 1
    CreateProcess() must be called using "ByVal 0&", otherwise e.g. nslookup will not work: lngResult = CreateProcess(0&, szFullCommand, tSA_CreateProcessPrc, tSA_CreateProcessThrd, True, 0&, ByVal 0&, vbNullString, tStartupInfo, tSA_CreateProcessPrcInfo) –  Aug 28 '13 at 17:48
  • @Martin: Thanks! I was unable to connect to the server (unable to resolve host) due to that exact reason. I updated the "pastebin" code: http://pastebin.com/w9zzNK4N – lepe Oct 29 '13 at 02:55
  • Not suitable for 64-bit systems? The declares "must be reviewed" and marked with the ptrsafe attribute? – user3791372 Sep 23 '15 at 16:55
  • 1
    Is there a worked example please of how to get this to run? Using Windows 8, 64 bit. – QHarr Nov 24 '17 at 09:09
6

You could always redirect the shell output to a file, then read the output from the file.

Lance Roberts
  • 21,279
  • 29
  • 106
  • 128
  • I guess the trick here would be how do you know that the command is finished writing to the file (in an easy way)? I guess you need to loop until the file becomes not readonly. – NoChance Oct 05 '20 at 01:26
  • Maybe create a dummy file when done, and poll for that in Excel? – Tuntable Oct 06 '20 at 07:22
  • 1
    I use file watchers to tell when a file has been written to. Put a flag in the file to let you know it is finished. – scott_f Jan 18 '21 at 19:25
6

Based on Brian Burns' answer, I added passing input (using StdInput) to the executable during the call. Just in case somebody stumbles upon this and has the same need.

''' <summary>
'''   Executes the given executable in a shell instance and returns the output produced
'''   by it. If iStdInput is given, it is passed to the executable during execution.
'''   Note: You must make sure to correctly enclose the executable path or any given
'''         arguments in quotes (") if they contain spaces.
''' </summary>
''' <param name="iExecutablePath">
'''   The full path to the executable (and its parameters). This string is passed to the
'''   shell unaltered, so be sure to enclose it in quotes if it contains spaces.
''' </param>
''' <param name="iStdInput">
'''   The (optional) input to pass to the executable. Default: Null
''' </param>
Public Function ExecuteAndReturnStdOutput(ByVal iExecutablePath As String, _
                                 Optional ByVal iStdInput As String = vbNullString) _
                As String

   Dim strResult As String

   Dim oShell As WshShell
   Set oShell = New WshShell

   Dim oExec As WshExec
   Set oExec = oShell.Exec(iExecutablePath)

   If iStdInput <> vbNullString Then
      oExec.StdIn.Write iStdInput
      oExec.StdIn.Close    ' Close input stream to prevent deadlock
   End If

   strResult = oExec.StdOut.ReadAll
   oExec.Terminate

   ExecuteAndReturnStdOutput = strResult

End Function

Note: You will need to add a reference to Windows Script Host Object Model so the types WshShell and WshExec are known.
(To do this go to Extras -> References in the VBA IDE's menu bar.)

You can use the following small C# program to test your call from VBA. (If you don't have Visual Studio (Express) handy, you can follow these instructions to quickly compile it from a simple source file.):

using System;

class Program
{
   static void Main(string[] args)
   {
      // Read StdIn
      string inputText = Console.In.ReadToEnd();

      // Convert input to upper case and write to StdOut
      Console.Out.Write(inputText.ToUpper());
   }
}

In VBA you could then run the following method that should show you a message box containing "ABCDEF":

Public Sub TestStdIn()
   MsgBox ExecuteAndReturnStdOutput("C:\ConvertStdInToUpper.exe", "abcdef")
End Sub
Marcus Mangelsdorf
  • 2,198
  • 1
  • 27
  • 35
  • What's the "Close input stream to prevent deadlock" comment about? – wqw Mar 12 '20 at 16:25
  • @wqw: If you don't close the input stream, the called application will stay open indefinitely, waiting for the input to finish. I've added a small example C# console application to my answer that you can use to test the behavior when not closing the stream. – Marcus Mangelsdorf Mar 12 '20 at 20:46
  • ok, 10x, I see what you mean. Never experienced a need to close stdin this way, neither using utilities so daft to require it. If an utility requires an input from *console* it usually is a simple confirmation of some kind (y/n) or a password. Passing a whole *file* that ends with Ctrl+Z is so CP/M style of IPC -- no one does it nowadays. Most utilities get a file *name* with something like "-o output.out" or similar. Another case is a VSCode language server and here StdIn is not supposed to be closed but is used interactively to receive commands as cheap bi-directional IPC. Cheers! – wqw Mar 12 '20 at 23:25
3
Sub StdOutTest()
    Dim objShell As Object
    Dim objWshScriptExec As Object
    Dim objStdOut As Object
    Dim rline As String
    Dim strline As String

    Set objShell = CreateObject("WScript.Shell")
    Set objWshScriptExec = objShell.Exec("c:\temp\batfile.bat")
    Set objStdOut = objWshScriptExec.StdOut

    While Not objStdOut.AtEndOfStream
        rline = objStdOut.ReadLine
        If rline <> "" Then strline = strline & vbCrLf & CStr(Now) & ":" & Chr(9) & rline
       ' you can handle the results as they are written to and subsequently read from the StdOut object
    Wend
    MsgBox strline
    'batfile.bat
    'ping 1.1.1.1 -n 1 -w 2000 > nul
    'echo 2
    'ping 1.1.1.1 -n 1 -w 2000 > nul
    'echo 4
    'ping 1.1.1.1 -n 1 -w 2000 > nul
    'echo 6
    'ping 1.1.1.1 -n 1 -w 2000 > nul
    'echo 8
End Sub
xlecoustillier
  • 15,451
  • 14
  • 56
  • 79
3

Based on the various answers mostly the one from Brian Burns, here is a shorten version, tested and functional :

Function F_shellExec(sCmd As String) As String
    Dim oShell   As New WshShell 'requires ref to Windows Script Host Object Model
    F_shellExec = oShell.Exec(sCmd).StdOut.ReadAll
End Function

it works pretty fine and it's quite fast. BUT, if the output is too large (for example scanning the whole C: drive sCmd = "DIR /S C:\"), ReadAll willl crash

So I came up with the 2nd solution bellow, which so far works fine, in both cases. Note that the 1st reading is faster, and that if it crash, the reading restart at the beginning, so you don't miss information

Function F_shellExec2(sCmd As String) As String
    'Execute Windows Shell Commands
    Dim oShell  As New WshShell 'requires ref to Windows Script Host Object Model
    'Dim oExec   As WshExec 'not needed, but in case you need the type
    Dim oOutput As TextStream
    Dim sReturn As String
    Dim iErr    As Long

    'Set oExec = oShell.Exec(sCmd) 'unused step, for the type
    Set oOutput = oShell.Exec(sCmd).StdOut

    On Error Resume Next
    sReturn = oOutput.ReadAll
    iErr = Err.Number
    On Error GoTo 0

    If iErr <> 0 Then
        sReturn = ""
        While Not oOutput.AtEndOfStream
            sReturn = sReturn & oOutput.ReadLine & Chr(10)
        Wend
    End If

    F_shellExec2 = sReturn

End Function
Rafiki
  • 492
  • 4
  • 14
2

This function provides a quick way to run a Command Line command, using the clipboard object:

Capture command-line output:

Function getCmdlineOutput(cmd As String)
    CreateObject("WScript.Shell").Run "cmd /c """ & cmd & "|clip""", 0, True 'output>clipbrd
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") 'latebound clipbrd obj
        .GetFromClipboard                                 'get cmdline output from clipboard
        getCmdlineOutput = .GetText(1)                    'return clipboard contents
    End With
End Function

Example usage:

Sub Demo1()
    MsgBox getCmdlineOutput("w32tm /tz")  'returns the system Time Zone information
End Sub

It uses the WShell Run command because it optionally allows for asynchronous execution, meaning it will wait for the command to finish running before VBA continues, which is important when involving the clipboard.

It also utilizes a built-in but often-forgotten command line utility called clip.exe, in this case as a destination for the piped cmdline output.

Clipboard manipulation requires a reference to the Microsoft Forms 2.0 library, which in this case I created with a Late-bound reference (which looks different since MS Forms - aka fm20.dll - is a Windows library, not VBA).


Preserving Existing Clipboard Data:

In my case it was an issue that the function above wipes the existing clipboard data, so the function below is modified to retain & replace existing text on the clipboard.

If there is something other than text on the clipboard you'll be warned that it will be lost. Some heavy coding could allow for other/any type of clipboard data to be returned... but advanced clipboard manipulation is far more complex than most users realize, and I frankly don't have the need or desire to get into it. More info here.

Note that this in this method MS Forms is Early-Bound but could be changed if desired. (But remember as a general rule of thumb, late-binding generally doubles processing time.)

Function getCmdlineOutput2(cmd As String)
'requires Reference: C:\Windows\System32\FM20.DLL (MS Forms 2.0) [Early Bound]
    Dim objClipboard As DataObject, strOrigClipbrd As Variant
    Set objClipboard = New MSForms.DataObject   'create clipboard object
    objClipboard.GetFromClipboard               'save existing clipboard text

    If Not objClipboard.GetFormat(1) Then
        MsgBox "Something other than text is on the clipboard.", 64, "Clipboard to be lost!"
    Else
        strOrigClipbrd = objClipboard.GetText(1)
    End If

    'shell to hidden commandline window, pipe output to clipboard, wait for finish
    CreateObject("WScript.Shell").Run "cmd /c """ & cmd & "|clip""", 0, True
    objClipboard.GetFromClipboard               'get cmdline output from clipboard
    getCmdlineOutput2 = objClipboard.GetText(1) 'return clipboard contents
    objClipboard.SetText strOrigClipbrd, 1      'Restore original clipboard text
    objClipboard.PutInClipboard
End Function

Example Usage:

Sub Demo2()
    MsgBox getCmdlineOutput2("dir c:\")  'returns directory listing of C:\
End Sub
ashleedawg
  • 17,207
  • 5
  • 53
  • 80