从 VBA 中的 shell 命令捕获输出值？
Posted
技术标签:
【中文标题】从 VBA 中的 shell 命令捕获输出值？【英文标题】：Capture output value from a shell command in VBA? 【发布时间】：2022-01-14 13:04:41 【问题描述】：在http://www.cpearson.com/excel/ShellAndWait.aspx找到这个功能
但我还需要捕获 shell 的输出。有什么代码建议吗？
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
【问题讨论】：
【参考方案1】：您总是可以将 shell 输出重定向到一个文件，然后从该文件中读取输出。
【讨论】：
我猜这里的诀窍是你怎么知道命令已经完成了对文件的写入（以一种简单的方式）？我猜你需要循环直到文件变为非只读。 也许在完成后创建一个虚拟文件，然后在 Excel 中进行轮询？ 我使用文件观察器来判断文件何时被写入。在文件中放置一个标志，让您知道它已完成。【参考方案2】：您可以CreateProcess 应用程序将其StdOut 重定向到管道，然后直接读取该管道； http://pastebin.com/CszKUpNS
dim resp as string
resp = redirect("cmd","/c dir")
resp = redirect("ipconfig","")
【讨论】：
抱歉，您的代码是如何运行的？我正在尝试做类似的事情（将标准输出数据拉入 VBA，并且我在 OSX 上运行），但我不确定在哪里声明你的函数。我尝试将它们放在定义我的用户表单功能的同一文件夹中，当他们单击提交时，它给了我一个错误，指出“编译错误：在 End Sub、End Function 或 End Property 之后只能出现 cmets”。跨度> 这是 Windows 特定代码，因为它使用 Windows API；无论您做什么，它都不会在 OSX 上运行 - 最好提出一个新问题。 CreateProcess() 必须使用“ByVal 0&”调用，否则例如nslookup 将不起作用：lngResult = CreateProcess(0&, szFullCommand, tSA_CreateProcessPrc, tSA_CreateProcessThrd, True, 0&, ByVal 0&, vbNullString, tStartupInfo, tSA_CreateProcessPrcInfo) @Martin：谢谢！由于这个确切原因，我无法连接到服务器（无法解析主机）。我更新了“pastebin”代码：pastebin.com/w9zzNK4N 请问有一个可行的例子来说明如何让它运行吗？使用 Windows 8，64 位。【参考方案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
【讨论】：
【参考方案4】：根据 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:\")
【讨论】：
我在最近的Python post 上记下了你的这个绝妙答案。随意直接回答，我会删除我自己的。 我无法使用您的示例使其正常工作。我需要ShellRun("cmd.exe /c dir c:\")。然后它完美地工作了。谢谢。
这里你不需要while循环，你可以从Set oOutput = oExec.StdOut这一行替换到函数的最后一行：ShellRun = oExec.StdOut.ReadAll
另外，如果您需要单独的行，那么您可以ShellRun = Split(oExec.StdOut.ReadAll, vbCrLf)，并将函数声明更改为Public Function ShellRun(sCmd As String) As String()。这给出了一个 0 索引的字符串数组。
谢谢你 - 我已经绞尽脑汁好几个小时试图找到一个解决方案来从 powershell 命令中获得返回。有没有办法改变壳牌，让它不可见？【参考方案5】：
基于Brian Burns' 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 -> References。）
您可以使用以下小型 C# 程序来测试您从 VBA 中的调用。 （如果手边没有Visual Studio (Express)，可以关注these instructions，从一个简单的源文件快速编译。）：
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
【讨论】：
“关闭输入流以防止死锁”评论是关于什么的？ @wqw：如果不关闭输入流，被调用的应用程序将无限期保持打开状态，等待输入完成。我在我的答案中添加了一个小的示例 C# 控制台应用程序，您可以使用它来测试不关闭流时的行为。 好的，10x，我明白你的意思了。从来没有经历过需要以这种方式关闭标准输入，也没有使用如此愚蠢的实用程序来要求它。如果一个实用程序需要来自 console 的输入，它通常是某种简单的确认 (y/n) 或密码。传递以 Ctrl+Z 结尾的整个 文件 是 IPC 的 CP/M 风格——现在没有人这样做。大多数实用程序都会获得一个文件 name，其中包含“-o output.out”或类似内容。另一种情况是 VSCode 语言服务器，这里的 StdIn 不应该关闭，而是以交互方式用于接收命令作为廉价的双向 IPC。干杯！【参考方案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 是早期绑定，但可以根据需要进行更改。 （但请记住，作为一般经验法则，后期绑定通常加倍处理时间。）
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
【讨论】：
【参考方案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 命令捕获输出值？的主要内容，如果未能解决你的问题，请参考以下文章