Excel VBA 编程
首页 » Excel 课程 » Excel VBA 编程 » 从 Excel 启动其他应用程序

从 Excel 启动其他应用程序

0

有时我们可能需要在 Excel 中调用其它 Windows 应用程序，比如：打开 Edge 浏览器，打开 Windows 对话框，或者执行 DOS 批处理文件等。本课程主要介绍从 Excel 启动各种 Windows 应用程序时需要的主要函数。

使用 VBA 的 Shell 函数

示例一：启动 Windows 的计算器

Sub StartCalc()
    Dim Program As String
    Dim TaskID As Double
    On Error Resume Next
    Program = "calc.exe"
    TaskID = Shell(Program, 1)
    If Err <> 0 Then
        MsgBox "不能启动 " & Program, vbCritical, "Error"
    End If
End Sub

Shell 函数返回在第一个参数中指定的应用程序的任务 ID 编号。可以使用这个任务 ID 编号在稍后激活该任务。第二个参数确定如何显示应用程序（1表示窗口具有原始大小和位置，并带有焦点）。

如果 Shell 函数没有成功，那么会产生错误。因此，该过程使用了一个 On Error 语句，如果未发现可执行文件或发生其他错误，则会显示一条消息。

示例二：监视 Shell 函数启动的应用程序的状态

Shell 函数启动的应用程序正在运行时，VBA代码不会中止，即 Shell 函数是异步运行应用程序的。如果执行 Shell 函数后，过程还有其他指令，它们会与新加载的程序同时执行。如果指令要求用户交互（如显示一个消息框），那么 Excel 的标题栏会在其他应用程序活动时闪烁。

有时我们可能需要用 Shell 函数启动一个应用程序，但需要在应用程序关闭之前暂停 VBA 代码的运行，虽然不能中止代码的执行，但可创建一个循环，专门用来监视应用程序的状态。

Declare PtrSafe Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess As Long, _
    ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As Long

Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" _
    (ByVal hProcess As Long, _
    lpExitCode As Long) As Long

Sub StartCalc2()
    Dim TaskID As Long
    Dim hProc As Long
    Dim lExitCode As Long
    Dim ACCESS_TYPE As Integer, STILL_ACTIVE As Integer
    Dim Program As String

    ACCESS_TYPE = &H400
    STILL_ACTIVE = &H103

    Program = "calc.exe"
    On Error Resume Next

'   启动任务
    TaskID = Shell(Program, 1)

'   获取进程句柄
    hProc = OpenProcess(ACCESS_TYPE, False, TaskID)
    
    If Err <> 0 Then
        MsgBox "不能启动 " & Program, vbCritical, "Error"
        Exit Sub
    End If
    
    Do  '一直执行循环
'       检查进程
        GetExitCodeProcess hProc, lExitCode
'       允许事件处理
        DoEvents
    Loop While lExitCode = STILL_ACTIVE
    
'   任务完成，显示消息
    MsgBox Program & " 已关闭."
End Sub

当启动的应用程序正在运行时，该过程会持续从 Do...Loop 循环中调用 GetExitCodeProcess 函数，检测其变量 IExitCode 返回值。过程结束时，IExitCode 返回一个不同的值，结束循环，并且 VBA 代码恢复执行。

示例三：显示文件夹窗口

你也可以使用 Shell 函数来打开 Windows 资源管理器来显示一个特定目录。例如，以下 VBA 代码打开活动工作簿所在的文件夹（仅当工作簿已经被保存后）：

If ActiveWorkbook.Path <> "" Then
    Shell "explorer.exe " & ActiveWorkbook.Path, vbNormalFocus
End If

使用 Windows 的 ShellExecute API 函数

ShellExecute 函数只能启动文件类型已在 Windows 中已注册的应用程序。例如，可使用 ShellExecute 函数启动默认的 Web 浏览器来打开一个 Web 文档；或启动默认的文本程序来打开一个文本文档。

API声明

使用 ShellExecute 函数前需要 API 声明，以下代码与所有 Excel 版本兼容。

#If VBA7 And Win64 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" _
  Alias "ShellExecuteA" (ByVal hWnd As Long, _
  ByVal lpOperation As String, ByVal lpFile As String, _
  ByVal lpParameters As String, ByVal lpDirectory As String, _
  ByVal nShowCmd As Long) As Long
#Else
Private Declare Function ShellExecute Lib "shell32.dll" _
  Alias "ShellExecuteA" (ByVal hWnd As Long, _
  ByVal lpOperation As String, ByVal lpFile As String, _
  ByVal lpParameters As String, ByVal lpDirectory As String, _
  ByVal nShowCmd As Long) As Long
#End If

示例：打开图形文件

本示例使用默认的图形程序打开一个 JPG 图形文件。

Sub ShowGraphic()
    Dim FileName As String
    Dim Result As Long
    FileName = ThisWorkbook.Path & "\dog.jpg"
    Result = ShellExecute(0&, vbNullString, FileName, vbNullString, vbNullString, vbNormalFocus)
    If Result < 32 Then MsgBox "Error"
End Sub

示例：打开文本文件

本示例使用默认的文本文件程序打开一个 TXT 文本文件。

Sub OpenTextFile()
    Dim FileName As String
    Dim Result As Long
    FileName = ThisWorkbook.Path & "\textfile.txt"
    Result = ShellExecute(0&, vbNullString, FileName, vbNullString, vbNullString, vbNormalFocus)
    If Result < 32 Then MsgBox "Error"
End Sub

示例：打开网址

本示例使用默认的浏览器打开一个网址。

Sub OpenURL()
    Dim URL As String
    Dim Result As Long
    URL = "https://oacourse.com"
    Result = ShellExecute(0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus)
    If Result < 32 Then MsgBox "Error"
End Sub

示例：发送电子邮件

本示例打开默认的电子邮件客户端程序，准备发送一封电子邮件到一个邮件地址。

Sub StartEmail()
    Dim Addr As String
    Dim Result As Long
    Addr = "mailto:[email protected]"
    Result = ShellExecute(0&, vbNullString, Addr, vbNullString, vbNullString, vbNormalFocus)
    If Result < 32 Then MsgBox "Error"
End Sub

示例：播放音乐文件

本示例打开默认的音乐播放器，播放一首 MP3。

Sub PlayMP3()
    Dim FileName As String
    Dim Result As Long
    FileName = ThisWorkbook.Path & "\happy.mp3"
    Result = ShellExecute(0&, vbNullString, FileName, vbNullString, vbNullString, vbNormalFocus)
    If Result < 32 Then MsgBox "Error"
End Sub

使用 AppActivate 语句

如果一个应用程序已经在运行，如果再使用 Shell 函数会启动它的另一个实例。大多数情况下，我们只需要激活正在运行中的实例，而不是启动它的另一个实例。

以下示例使用 AppActivate 语句来激活一个正在运行的 Windows 计算器。AppActivate 的参数是应用程序标题栏的标题。如果 AppActivate 语句产生错误，则表示计算器没有运行，因此，该示例会启动该应用程序。

Sub ActivateCalc()
    Dim AppFile As String
    Dim CalcTaskID As Double
    
    AppFile = "Calc.exe"
    On Error Resume Next
    AppActivate "计算器"
    If Err <> 0 Then
        Err = 0
        CalcTaskID = Shell(AppFile, 1)
        If Err <> 0 Then MsgBox "不能启动计算器"
    End If
End Sub

激活“控制面板”对话框

我们可以在 Excel 中使用 VBA 的 Shell 函数来调用 rundll32.exe 应用程序，使其启动 Windows 控制面板中的系统对话框和向导。

Rundll32.exe 语法

Rundll32.exe DLLname,Functionname [Arguments]

Rundll32.exe 就是“执行32位的 DLL 文件”，它的功能就是以命令行的方式调用动态链接程序库。

DLLname 为需要执行的 DLL 文件名；Functionname 为需要执行的 DLL 文件的具体引出函数；[Arguments] 为引出函数的具体参数。

示例：显示本地安装的打印机

Sub ViewPrinters()
    Dim Arg As String
    Dim TaskID As Double
    Arg = "rundll32.exe shell32.dll,SHHelpShortcuts_RunDLL PrintersFolder"
    On Error Resume Next
    TaskID = Shell(Arg)
    If Err <> 0 Then
        MsgBox ("无法启动此应用程序。")
    End If
End Sub

常用 Rundll32.exe 命令

系统重启
rundll32.exe user.exe,restartwindows

关闭系统
rundll32.exe user.exe,exitwindows

打开控制面板
rundll32.exe shell32.dll,Control_RunDLL

添加新打印机
rundll32.exe shell32.dll,SHHelpShortcuts_RunDLL AddPrinter

日期和时间
rundll32.exe shell32.dll,Control_RunDLL timedate.cpl,,0

❮ 在 Excel 中模拟 Word 的邮件合并功能使用 VBA 开启“信任对 VBA 工程对象模型的访问” ❯

评论

您的电子邮件地址不会显示出来。*号为必填项。