Захватить выходное значение из команды оболочки в VBA?

Question

Нашел эту функцию http://www.cpearson.com/excel/ShellAndWait.aspx

Но потребуется также захватить вывод из вывода оболочки. Любое предложение кода?

Answer 1

Основываясь на ответе Эндрю Лессарда, вот функция для запуска команды и возврата вывода в виде строки -

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

Вы всегда можете перенаправить вывод оболочки в файл, а затем прочитать вывод из файла.

Answer 4

Основываясь на ответе bburns.km , я добавил проходной ввод (используя 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.)

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 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 произойдет сбой

Итак, я придумал 2-е решение, приведенное ниже, которое до сих пор отлично работает в обоих случаях. Обратите внимание, что 1-е чтение происходит быстрее, и что в случае сбоя чтение возобновляется в начале, поэтому вы не пропустите информацию

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

Answer 7

Эта функция обеспечивает быстрый способ запуска команды командной строки с использованием объекта буфера обмена:

Вывод из командной строки захвата:

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 - иначе * 1027) *fm20.dll - это библиотека Windows, а не VBA).

---

Сохранение существующих данных буфера обмена:

В моем случае проблема заключалась в том, что функция выше стирает существующие данные буфера обмена, поэтому функция ниже модифицируется для сохранения и замены существующего текста в буфере обмена.

Если в буфере обмена есть что-то, кроме текста, вы будете предупреждены, что оно будет потеряно. Некоторое тяжелое кодирование может позволить возвращать другие / любые типы данных буфера обмена ... но расширенные манипуляции с буфером обмена намного сложнее, чем понимают большинство пользователей, и у меня, честно говоря, нет необходимости или желания в них разбираться. Подробнее здесь .

Обратите внимание, что в этом методе MS Forms имеет значение Early-Bound , но может быть изменено при желании. (Но помните, как общее правило, позднее связывание обычно удваивает время обработки.)

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