Private Sub Command1_Click()
Set ws = CreateObject("wscript.shell")
strProcess = "qq1.exe" '判断的进程
Proce = False
For Each x In GetObject("winmgmts:").instancesof("win32_process")
      If UCase(x.Name) = UCase(strProcess) Then
        Proce = True
        Exit For
      End If
Next
If Proce Then
    MsgBox "系统检测本程序已经在运行了！"
    '结束程序代码
   Else
    MsgBox "系统检测本程序没有运行"
End If

End Sub