从 VBA 中的 shell 命令捕获输出值？

Capture output value from a shell command in VBA?

提问by user310291

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

在http://www.cpearson.com/excel/ShellAndWait.aspx上找到了这个函数

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

但我还需要捕获 shell 的输出。任何代码建议？

Option Explicit
Option Compare Text

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modShellAndWait
' By Chip Pearson, [email protected], 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

采纳答案by Alex K.

You can CreateProcessthe application redirecting its StdOutto a pipe, then read that pipe directly; http://pastebin.com/CszKUpNS

您可以CreateProcess将应用程序重定向StdOut到管道，然后直接读取该管道；http://pastebin.com/CszKUpNS

dim resp as string 
resp = redirect("cmd","/c dir")
resp = redirect("ipconfig","")

回答by Brian Burns

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

基于 Andrew Lessard 的回答，这是一个运行命令并将输出作为字符串返回的函数 -

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:\")

回答by Lance Roberts

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

你总是可以将 shell 输出重定向到一个文件，然后从文件中读取输出。

回答by Marcus Mangelsdorf

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

根据Brian Burns 的回答，我在调用期间向可执行文件添加了传递输入（使用StdInput）。以防万一有人偶然发现并有同样的需求。

''' <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 Modelso the types WshShelland WshExecare known.
(To do this go to Extras-> Referencesin the VBA IDE's menu bar.)

注意：您将需要添加Windows Script Host Object Model对类型WshShell和WshExec已知的引用。
（要执行此操作，请转到VBA IDE 菜单栏中的Extras-> References。）

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 instructionsto quickly compile it from a simple source file.):

您可以使用以下小 C# 程序来测试来自 VBA 的调用。（如果您手边没有 Visual Studio (Express)，您可以按照这些说明从一个简单的源文件快速编译它。）：

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":

在 VBA 中，您可以运行以下方法，该方法将显示一个包含“ABCDEF”的消息框：

Public Sub TestStdIn()
   MsgBox ExecuteAndReturnStdOutput("C:\ConvertStdInToUpper.exe", "abcdef")
End Sub

回答by Andrew Lessard

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

回答by Rafiki

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

根据主要来自 Brian Burns 的各种答案，这是一个经过测试且功能强大的缩短版本：

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:\"), ReadAllwilll crash

它工作得很好，而且速度非常快。但是，如果输出太大（例如扫描整个 C: 驱动器sCmd = "DIR /S C:\"），ReadAll将会崩溃

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

回答by ashleedawg

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 Runcommandbecause 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.

它使用WShellRun命令，因为它可以选择允许异步执行，这意味着它将在 VBA 继续之前等待命令完成运行，这在涉及剪贴板时很重要。

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

它还利用了一个内置但经常被遗忘的命令行实用程序，称为clip.exe，在这种情况下作为管道cmdline输出的目的地。

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

剪贴板操作需要对Microsoft Forms 2.0库的引用，在这种情况下，我使用后期绑定引用创建了它（看起来不同，因为 MS Forms - aka fm20.dll- 是一个 Windows 库，而不是 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-Boundbut could be changed if desired. (But remember as a general rule of thumb, late-binding generally doublesprocessing time.)

请注意，此方法中的 MS Forms 是早期绑定的，但可以根据需要进行更改。（但请记住，一般的经验法则是，后期绑定通常会使处理时间加倍。）

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