Excel VBA 调用 Shell 命令

作者: , 共 10890 字

某些时候,我们需要在 Excel 中调用命令行或者 Bash 脚本, VBA 可以通过 Shell 函数很方便地做到这一点。以下用ipconfig /all来举例,这条命令行语句用来获得机器的网路配置信息,包括 IP、网关等信息。它可以替换成任何一个 bash 脚本和命令行代码。

1. 普通调用

运行下面这条 VBA 语句,会闪出一个命令行窗口,窗口里执行了ipconfig /all命令行:

Shell "ipconfig /all"

但默认情况下, Shell 函数执行完毕之后窗口便被关闭。ipconfig /all速度很快,命令行窗口会一闪而过,用户根本看不到运行结果。下面是两个解决方法。

2. 让命令行窗口运行完毕不自动关闭

一种解决方法是命令行窗口在运行完毕之后不关闭,这样用户可以看到上次的运行结果。这只需要在原来的命令行前面添加 cmd /k

Shell "cmd /k ipconfig /all"

为了方便,可以先设立一个函数来自动处理这件

Function RunShell(cmd As String, _
        Optional windowstyle As VbAppWinStyle = vbMinimizedFocus) _
        As Double
    RunShell = Shell("cmd /k """ & cmd & """", windowstyle)
End Function

然后运行RunShell "ipconfig /all"即可。

3. VBA Excel 和 Shell 交互

在 Excel VBA 中通过 Shell 直接调用命令行, Excel 和命令行进程是并行运行的, Excel 不会等待命令行运行完毕便会继续执行后面的代码,两者之间也不存在交互( VBA 中 Shell 函数返回值是进程 ID )。通过下面这个ShellAndWait函数调用命令行, Excel 函数会等待命令行运行完毕才会继续运行,并且可以获得命令行的运行结果和错误信息。

Function ShellAndWait(cmd As String) As String 
    Dim oShell As Object, oExec As Object
    Set oShell = CreateObject("WScript.Shell")
    Set oExec = oShell.exec(cmd)
    ShellAndWait = oExec.StdOut.ReadAll

    Set oShell = Nothing
    Set oExec = Nothing
End Function

这样运行res = ShellAndWait("ipconfig /all"), Excel 会等待命令行窗口运行完毕,并获取命令行的运行结果进行后续处理。

4. 另一种解决方案

上述的方法是一种简单方法,适用于简单的命令行程序。但测试发现,对于复杂的命令行程序,运行结果和预期可能不一致。这时候可以使用下面功能更为强大的代码。该代码来自Pearson,我做了些方便使用上的简单修改。

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, _
        Optional TimeOutMs As Long = 1000000, _
        Optional ShellWindowState As VbAppWinStyle = vbNormalFocus, _
        Optional BreakKey As ActionOnBreak = promptuser) 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

使用方法同样为res = ShellAndWait("ipconfig /all")。这时候 Excel 会等待该命令行运行完毕才会继续运行接下来的 VB 代码。

Q. E. D.

类似文章:
编程 » VBA, Excel
如果不提供错误处理方法,VBA在出错时会停留在出错之处。Excel/VBA 提供On Error关键词来处理程序运行过程中的错误,具体有下面两种用法:
更新一下之前写的Excel 的数据库类,将其改成函数的形式,调用更简单(省却了生成类实例的步骤)。现在这个代码在工作中用了一年多,已经比较健壮。若有问题,请留言指出或与我联系。
编程 » Excel, VBA
某些时候需要打开 Excel 文件来获取或者写入数据,但又不希望跳出打开的 Excel 文件窗口,可以用下面的代码:
以前发过一个编辑和发送 Outlook 邮件的 Excel/VBA 脚本。最近公司不让用 Outlook ,强制使用 IBM Lotus Notes ,我又写了一个编辑和发送 Lotus 邮件的 VBA 脚本。
在工作中定期或不定期会收到一些数据文件,然后要将它们的附件保存到自己的电脑上,下面演示如何让 Outlook 自动做这件事情。
编程 » Excel, VBA
无意中发现一个 Excel VBA 对待参数的一个"不正常"现象。这种处理方式可能无意中导致程序结果错误,而且你很难发现你的错误所在:
编程 » Excel, lotus, VBA
公司使用 Lotus ,我每天都通过 Excel 编写 VBA 代码自动调用 Lotus 发送邮件,发现一个奇怪的现象。一般我们通过下面的 VBA 代码指定邮件收件人:
编程 » Excel, VBA
VBA 的 Date 类型比较奇怪。
相似度: 0.061
编程 » Excel, VBA
Excel VBA 出错时给出的错误信息极少,需要充分利用各种工具来进行调试。
编程 » Excel, VBA
效果图:
数学 » 悖论, 头脑风暴
最有名的关于换还是不换的问题是三门问题,已经被研究得比较透彻。这里想说的是另外一个悖论。
最近一个比较好玩的是 JP Morgan 出了一个伦敦鲸。