捕获命令行输出：

Question

找到了这个功能 http://www.cpearson.com/excel/ShellAndWait.aspx

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

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

Answer 2

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

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

Answer 3

您始终可以将shell输出重定向到文件，然后从文件中读取输出。

Answer 4

基于bburns.km's answer，我在调用期间向可执行文件添加了传递输入（使用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 Object Model的引用，以便了解WshShell和WshExec类型。
（要执行此操作，请转到VBA IDE菜单栏中的 Extras - ＆gt; 引用。）

Answer 5

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

Answer 6

此功能提供了使用剪贴板对象运行命令行命令的快速方法：

捕获命令行输出：

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 command是因为它可选地允许异步执行，这意味着它将在VBA继续之前等待命令完成运行，这在涉及剪贴板时很重要。

它还利用了一个内置的但经常被遗忘的命令行实用程序clip.exe，在这种情况下，它是通过管道发送 cmdline 输出的目标。

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

保留现有剪贴板数据：

在我的情况下，上面的功能会擦除现有剪贴板数据是一个问题，因此，下面的功能已被修改为保留并替换剪贴板上的现有文本。

如果剪贴板上除了文本以外还有其他内容，将会警告您它将丢失。一些沉重的编码可以允许返回其他/任何类型的剪贴板数据...但是高级剪贴板操作远比大多数用户意识到的复杂，而且我坦率地说没有必要或不希望进入。更多信息here。

请注意，此方法在MS Forms中是 Early-Bound ，但可以根据需要进行更改。（但请记住，一般而言，后期绑定通常 double 处理时间。）

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

Answer 7

基于各种答案（主要是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

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

7 个答案:

捕获命令行输出：

用法示例：

保留现有剪贴板数据：

用法示例：