在VBA中如何从shell命令中获取输出值？

Question

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

不过我还需要捕获来自shell的输出。有什么代码建议吗？

Option Explicit
Option Compare Text

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

- user310291

Answer 1

根据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

用法：

MsgBox ShellRun("dir c:\")

- Brian Burns

---

我在最近的Python帖子中称赞了你的出色回答。请随意直接回答，我将删除我的回答。 - Parfait

我无法通过你的示例使它工作。我需要使用 ShellRun("cmd.exe /c dir c:\")，然后它完美地运行了。谢谢你。 - mal

您不需要在此处使用while循环，您可以将从“Set oOutput = oExec.StdOut”行到函数结尾的部分替换为此行代码：“ShellRun = oExec.StdOut.ReadAll”。 - Pupa Rebbe

如果你需要单独的行，那么你可以使用ShellRun = Split(oExec.StdOut.ReadAll, vbCrLf)，并将函数声明更改为Public Function ShellRun(sCmd As String) As String()。这将返回一个从0开始索引的字符串数组。 - Greedo

谢谢这个 - 我已经努力了几个小时，试图找到一个解决方案来获取PowerShell命令的返回值。有没有办法改变Shell以使其隐藏起来？ - Tom

Answer 2

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

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

- Alex K.

---

抱歉，你是怎么让你的代码运行起来的？我正在尝试做类似的事情（将stdout数据拉入VBA，并在OSX上运行），但我不确定在哪里声明你的函数。我尝试将它们放在定义用户表单功能的同一文件夹中，当他们点击提交时，但它给了我一个错误，指出“编译错误：只有注释可以出现在End Sub、End Function或End Property之后”。 - Engineero

这是特定于 Windows 的代码，因为它使用了 Windows API；无论你做什么，它都无法在 OSX 上运行 - 最好提一个新问题。 - Alex K.

必须使用“ByVal 0＆”调用CreateProcess（），否则例如nslookup将无法工作：lngResult = CreateProcess（0＆，szFullCommand，tSA_CreateProcessPrc，tSA_CreateProcessThrd，True，0＆，ByVal 0＆，vbNullString，tStartupInfo，tSA_CreateProcessPrcInfo） - user2726485

@Martin：谢谢！我无法连接到服务器（无法解析主机）就是因为这个原因。我已更新“pastebin”代码：http://pastebin.com/w9zzNK4N。 - lepe

不适用于64位系统？声明“必须进行审核”并标记为ptrsafe属性？ - user3791372

有没有一个可行的示例，可以演示如何运行它？使用 Windows 8，64 位。 - QHarr

Answer 3

根据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

注意：您需要添加对Windows Script Host对象模型的引用，以便了解WshShell和WshExec这两种类型。
（要执行此操作，请转到VBA IDE菜单栏中的工具->引用。）

您可以使用以下简短的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());
   }
}

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

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

- Marcus Mangelsdorf

---

“关闭输入流以防止死锁”这个注释是什么意思？ - wqw

@wqw：如果您不关闭输入流，则被调用的应用程序将无限期地保持打开状态，等待输入完成。我在我的答案中添加了一个小的示例C#控制台应用程序，您可以使用它来测试不关闭流时的行为。 - Marcus Mangelsdorf

好的，十分感谢。我明白你的意思了。我从未有过这样关闭stdin的需求，也没有使用过需要这样做的工具。如果一个工具需要来自控制台的输入，通常是一种简单的确认（y/n）或密码。传递一个以Ctrl+Z结尾的整个文件是如此CP/M风格的IPC - 现在没有人这样做了。大多数实用程序会使用类似“-o output.out”之类的东西获取文件名称。另一种情况是VSCode语言服务器，在这里StdIn不应该被关闭，而是交互式地用作接收命令的廉价双向IPC。干杯！ - wqw

Answer 4

根据大多数答案（尤其是来自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

这个技术非常好用，速度也相当快。但是，如果输出内容太大（例如扫描整个C：驱动器 sCmd =“DIR / S C：\”），ReadAll 将会崩溃。

所以，我想出了下面的第二种解决方案，目前在两种情况下都运行良好。请注意，第一个读取更快，如果它发生崩溃，读取将从开头重新开始，因此您不会错过任何信息。

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

关于对“Windows Script Host Object Model”的引用： 您需要添加对“Windows Script Host Object Model”的引用，以便类型“WshShell”（和“WshExec”）得到识别。 （要做到这一点，请在VBA IDE的菜单栏中选择“工具”->“引用”）

- Rafiki

Answer 5

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

- Lance Roberts

---

我猜这里的诀窍是如何知道命令何时完成向文件写入（以一种简单的方式）？我猜你需要循环直到文件变为非只读状态。 - NoChance

完成后，可以创建一个虚拟文件，并在Excel中轮询该文件吗？ - Tuntable

我使用文件监视器来判断文件是否已被写入。在文件中放置一个标志以让您知道它已完成。 - scott_f

Answer 6

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

- Andrew Lessard

Answer 7

对于预期回报较小的情况，这是我见过的最短的命令：

MsgBox CreateObject("WScript.Shell").Exec("C:\Windows\SysWOW64\WHOAMI.EXE /USER /FO CSV").StdOut.ReadAll

- ALeXceL

Answer 8

这个功能提供了一种快速的方式来运行命令行命令，使用剪贴板对象：

捕获命令行输出：

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

---

使用示例：

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

---

它使用WShell Run命令，因为它可以选择异步执行，这意味着它会等待命令完成后VBA才会继续执行，这在涉及剪贴板时非常重要。

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

剪贴板操作需要引用Microsoft Forms 2.0库，在这种情况下，我使用了一个Late-bound引用（由于MS Forms - 即fm20.dll - 是一个Windows库，而不是VBA，所以看起来有所不同）。

---

保留现有剪贴板数据：

在我的情况下，上述函数会清除现有的剪贴板数据，因此下面的函数被修改以保留并替换剪贴板上的现有文本。

如果剪贴板上有文本以外的内容，系统会警告您它将会丢失。一些复杂的编码可以允许其他/任何类型的剪贴板数据被返回……但高级剪贴板操作比大多数用户意识到的要复杂得多，而且我坦率地说，我没有需要或愿望去涉足其中。更多信息请参见此处。

请注意，在此方法中，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

---

使用示例：

Sub Demo2()
    MsgBox getCmdlineOutput2("dir c:\")  'returns directory listing of C:\
End Sub

- ashleedawg