Question

基本上我想复制Windows 7风格的Snipping Tool，所以当你打开它时，它会准备好一个剪辑。但是在Windows 8中，它只是打开程序，你必须按CTRL + N或单击新建。我想避免使用Sleep（100）或其他时间函数，因为在某些负载下它对于不同的系统可能是不可靠的。我试过循环

While error <> 0
AppActivate "Snipping Tool", True
application.SendKeys "^N", True
exit sub
Wend

确定。这不是我使用的，但它是沿着相同的路线。问题在于它一直给出VB Debug错误（除了这个实例以外都是好的）并且破坏了这个可能的解决方案。在能够运行之前等待shell打开程序的任何其他想法

Application.SendKeys "^N", True

？我也尝试过使用

shell.Run FileLocation, 1 , True

但是它关闭后会运行sendkeys！这几乎就是我想要的。

编辑：以下工作代码

//Used to wait for 200 milliseconds in the Sub.
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Function IsExeRunning(sExeName As String, Optional sComputer As String = ".") As Boolean
On Error GoTo Error_Handler
Dim objProcesses    As Object

Set objProcesses = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2").ExecQuery("SELECT * FROM Win32_Process WHERE Name = '" & sExeName & "'")
If objProcesses.Count <> 0 Then IsExeRunning = True

Error_Handler_Exit:
On Error Resume Next
Set objProcesses = Nothing
Exit Function

Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
        "Error Number: IsExeRunning" & vbCrLf & _
        "Error Description: " & Err.Description, _
        vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function

Sub SnipTool()
Dim wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")

wsh.Run "C:\Windows\sysnative\SnippingTool.exe"
X = 0
Select Case Mid(Application.OperatingSystem, 21)
Case 6.02
Do Until IsExeRunning("SnippingTool.exe") = True Or X = 200
//added Timeout if snipping tool fails to load. Prevents Excel freezing.
X = X + 1
Loop
Sleep (200)
AppActivate "Snipping Tool", True
Application.SendKeys "^N", True
End Select
End Sub

Answer 1

你可以启动Exe然后从这里获取IsExeRunning函数：

http://www.devhut.net/2014/10/20/vba-wmi-determine-if-a-process-is-running-or-not/

循环使用Do直到IsExeRunning（SnippingToolExecutable）

Excel VBA使用Shell打开应用程序，然后等待它打开以继续执行命令

1 个答案: