vb6 - Visual Basic 6 检查正在运行的 Excel 实例

Question

我想检查在打开我的程序时是否有任何 excel 实例正在运行。使用了以下代码。

Const ERR_APP_NOTRUNNING As Long = 429
On Error Resume Next
Set xlApp = GetObject("Excel.Application")
If Err = ERR_APP_NOTRUNNING Then
Set xlApp = Nothing
Exit Sub
Else:
Set xlApp = Nothing
MsgBox ("Sorry, please restart after closing all Excel files.")
End
End If

此代码在 Office 2007 中运行良好。但它在 Office 2010 中不起作用。有人可以帮助我，以便它可以在迄今为止的所有 office 版本上运行吗？

Answer 1

这是检查正在运行的进程的 Win32 API 方法。将以下代码复制到模块中:

Option Explicit
DefLng A-Z

Private Const TH32CS_SNAPPROCESS As Long = &H2

Private Type PROCESSENTRY32
   dwSize As Long
   cntUsage As Long
   th32ProcessID As Long
   th32DefaultHeapID As Long
   th32ModuleID As Long
   cntThreads As Long
   th32ParentProcessID As Long
   pcPriClassBase As Long
   dwFlags As Long
   szExeFile As String * 260
End Type

Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, _
   ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, _
   lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, _
   lppe As PROCESSENTRY32) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public Function IsProcessRunning(ByVal sProcessEXE As String) As Boolean

   Dim lProcessSnapshot As Long
   Dim udtProcess As PROCESSENTRY32
   Dim bolExists As Boolean
   
   If LenB(sProcessEXE) <> 0 Then
      lProcessSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
      udtProcess.dwSize = LenB(udtProcess)
      
      If lProcessSnapshot > 0 Then
         If Process32First(lProcessSnapshot, udtProcess) <> 0 Then
            Do
               If InStr(1, Trim0(udtProcess.szExeFile), sProcessEXE, vbTextCompare) > 0 Then
                  bolExists = True
                  Exit Do
               End If
            Loop Until Process32Next(lProcessSnapshot, udtProcess) = 0
         End If
         
         'Close snapshot handle
         CloseHandle lProcessSnapshot
      End If
      
      'Return information
      IsProcessRunning = bolExists
   End If
   
End Function

Private Function Trim0(ByVal sText As String) As String
   Trim0 = Trim$(Replace$(sText, Chr$(0), vbNullString))
End Function

这样称呼

Debug.Print IsProcessRunning("excel.exe")