Private Sub Timer1_Timer()
    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set colProcesses = objWMIService.ExecQuery("SELECT * FROM Win32_Process")
    For Each objprocess In colProcesses
        If objprocess.Name = "QQ.exe" Then MsgBox "QQ正在运行", vbOKOnly, "提示": End
    Next
End Sub
'---------------------------貌似还是这种方法最好,方法二太臃肿
'==============================方法一==============================

Function CheckApplicationIsRun(ByVal szExeFileName As String) As Boolean
    On Error GoTo Err
    Dim WMI
    Dim Obj
    Dim Objs
    CheckApplicationIsRun = False
    Set WMI = GetObject("WinMgmts:")
    Set Objs = WMI.InstancesOf("Win32_Process")
    For Each Obj In Objs
        If InStr(UCase(szExeFileName), UCase(Obj.Description)) <> 0 Then
            CheckApplicationIsRun = True
            If Not Objs Is Nothing Then Set Objs = Nothing
            If Not WMI Is Nothing Then Set WMI = Nothing
            Exit Function
        End If
    Next
    If Not Objs Is Nothing Then Set Objs = Nothing
    If Not WMI Is Nothing Then Set WMI = Nothing
    Exit Function
Err:
    If Not Objs Is Nothing Then Set Objs = Nothing
    If Not WMI Is Nothing Then Set WMI = Nothing
End Function

Private Sub Command1_Click()
    If CheckApplicationIsRun("QQ.exe") = True Then
        MsgBox "QQ程序已运行"
    Else
        MsgBox "QQ程序没有运行"
    End If
End Sub
'==============================方法二==============================