2013-10-03 74 views
0

我正在对用户选择的服务器IP执行快速PING以确认它可以访问。WScript命令 - 运行最小化? (MSAccess/VBA)

下面的代码正是我所需要的,除了我想避免命令外壳窗口的快速闪烁。

我需要修改哪些内容才能最大限度地减少讨厌的CMD窗口?

SystemReachable (myIP) 

If InStr(myStatus, "Reply") > 0 Then 
    ' IP is Confirmed Reachable 
Else 
    ' IP is Not Reachable 
End If 

'''''''''''''''''''''' 
Function SystemReachable(ByVal strIP As String) 

Dim oShell, oExec As Variant 
Dim strText, strCmd As String 

strText = "" 
strCmd = "ping -n 1 -w 1000 " & strIP 

Set oShell = CreateObject("WScript.Shell") 
Set oExec = oShell.Exec(strCmd) 

Do While Not oExec.StdOut.AtEndOfStream 
    strText = oExec.StdOut.ReadLine() 
    If InStr(strText, "Reply") > 0 Then 
     myStatus = strText 
     Exit Do 
    Else 
     myStatus = "" 
    End If 
Loop 

End Function 
+0

可能重复(http://stackoverflow.com/questions/15128517/want-to-hide-command -prompt-window-in-using-wshshell-exec-method) –

+0

看到了这种方法,但没有奢望重定向到一个文件 - 多个用户。希望保持stdout方法。将继续寻找thx –

+1

回复:“没有奢望重定向到一个文件 - 多个用户” - 这是将从数据库前端执行的事情,你***是确保每个用户都有他们自己的本地副本前端,对吧......? –

回答

1

找到了一个非常可行的和沉默的做法:

Dim strCommand as string 
Dim strPing As String 

strCommand = "%ComSpec% /C %SystemRoot%\system32\ping.exe -n 1 -w 500 " & myIP & " | " & "%SystemRoot%\system32\find.exe /i " & Chr(34) & "TTL=" & Chr(34) 
strPing = fShellRun(strCommand) 

If strPing = "" Then 
    MsgBox "Not Connected" 
Else 
    MsgBox "Connected!" 
End If 

''''''''''''''''''''''''''' 

Function fShellRun(sCommandStringToExecute) 

' This function will accept a string as a DOS command to execute. 
' It will then execute the command in a shell, and capture the output into a file. 
' That file is then read in and its contents are returned as the value the function returns. 

' "myIP" is a user-selected global variable 

Dim oShellObject, oFileSystemObject, sShellRndTmpFile 
Dim oShellOutputFileToRead, iErr 

Set oShellObject = CreateObject("Wscript.Shell") 
Set oFileSystemObject = CreateObject("Scripting.FileSystemObject") 

    sShellRndTmpFile = oShellObject.ExpandEnvironmentStrings("%temp%") & oFileSystemObject.GetTempName 
    On Error Resume Next 
    oShellObject.Run sCommandStringToExecute & " > " & sShellRndTmpFile, 0, True 
    iErr = Err.Number 

    On Error GoTo 0 
    If iErr <> 0 Then 
     fShellRun = "" 
     Exit Function 
    End If 

    On Error GoTo err_skip 
    fShellRun = oFileSystemObject.OpenTextFile(sShellRndTmpFile, 1).ReadAll 
    oFileSystemObject.DeleteFile sShellRndTmpFile, True 

Exit Function 

err_skip: 
    fShellRun = "" 
    oFileSystemObject.DeleteFile sShellRndTmpFile, True 


End Function 
+0

这段代码适用于我,除了当我从VBA运行时,没有任何内容写入sShellRndTmpFile(它甚至没有创建)。但是,当我在命令行上运行sCommandStringToExecute&“>”&sShellRndTmpFile sShellRndTmpFile被创建。任何想法为什么? – Ivan

2

这个问题可能有点老了,但我想这个答案仍然可以提供帮助。 (使用Excel VBA测试,无法使用Access进行测试)

WshShell.Exec方法允许使用.StdIn,.StdOut和.StdErr函数来写入和读取CONSOL窗口。 WshShell.Run方法不允许使用此功能,因此在某些情况下需要使用Exec。

尽管确实没有内置函数来启动最小化或隐藏的Exec方法,但您可以使用API​​快速查找Exec窗口hwnd并最小化/隐藏它。

我的下面的脚本使用Exec对象的ProcessID来查找窗口的Hwnd。使用Hwnd,您可以设置窗口的显示状态。

从我使用Excel 2007 VBA进行测试,在大多数情况下,我甚至没有看到窗口......在某些情况下,它可能会在几毫秒内可见,但只会出现快速闪烁或闪烁......注意:使用SW_MINIMIZE比使用SW_HIDE有更好的结果,但你可以玩弄它。

我添加了TestRoutine Sub以显示如何使用'HideWindow'函数的示例。 'HideWindow'函数使用'GetHwndFromProcess'函数从ProcessID获取窗口hwnd。

放置下面成一个模块...

Option Explicit 
' ShowWindow() Commands 
Public Const SW_HIDE = 0 
Public Const SW_MINIMIZE = 6 
'GetWindow Constants 
Public Const GW_CHILD = 5 
Public Const GW_HWNDFIRST = 0 
Public Const GW_HWNDLAST = 1 
Public Const GW_HWNDNEXT = 2 
Public Const GW_HWNDPREV = 3 
Public Const GW_OWNER = 4 
' API Functions 
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long 
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long 
Public Declare Function GetDesktopWindow Lib "user32"() As Long 
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long 


Sub TestRoutine() 
    Dim objShell As Object 
    Dim oExec As Object 
    Dim strResults As String 

    Set objShell = CreateObject("WScript.Shell") 
    Set oExec = objShell.Exec("CMD /K") 
    Call HideWindow(oExec.ProcessID) 

    With oExec 
     .StdIn.WriteLine "Ping 127.0.0.1" 
     .StdIn.WriteLine "ipconfig /all" 
     .StdIn.WriteLine "exit" 
     Do Until .StdOut.AtEndOfStream 
      strResults = strResults & vbCrLf & .StdOut.ReadLine 
      DoEvents 
     Loop 
    End With 
    Set oExec = Nothing 
    Debug.Print strResults 
End Sub 


Function HideWindow(iProcessID) 
    Dim lngWinHwnd As Long 
    Do 
     lngWinHwnd = GetHwndFromProcess(CLng(iProcessID)) 
     DoEvents 
    Loop While lngWinHwnd = 0 
    HideWindow = ShowWindow(lngWinHwnd, SW_MINIMIZE) 
End Function 

Function GetHwndFromProcess(p_lngProcessId As Long) As Long 
    Dim lngDesktop As Long 
    Dim lngChild As Long 
    Dim lngChildProcessID As Long 
    On Error Resume Next 
    lngDesktop = GetDesktopWindow() 
    lngChild = GetWindow(lngDesktop, GW_CHILD) 
    Do While lngChild <> 0 
     Call GetWindowThreadProcessId(lngChild, lngChildProcessID) 
     If lngChildProcessID = p_lngProcessId Then 
      GetHwndFromProcess = lngChild 
      Exit Do 
     End If 
     lngChild = GetWindow(lngChild, GW_HWNDNEXT) 
    Loop 
    On Error GoTo 0 
End Function 

ShowWindow函数: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633548%28v=vs.85%29.aspx

GetWindow功能: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633515%28v=vs.85%29.aspx

GetDesktopWindow功能: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633504%28v=vs.85%29.aspx

GetWindowThr eadProcessId功能: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633522%28v=vs.85%29.aspx

如果您需要更多关于API工作方式的信息,快速谷歌搜索将为您提供大量信息。

我希望这可以帮助...谢谢。

1

wscript的运行方法已经包含要运行最小化的参数。因此,没有上面显示所有这些努力只是使用

旧代码

oShellObject.Run sCommandStringToExecute & " > " & sShellRndTmpFile, 0, True 

新代码

oShellObject.Run sCommandStringToExecute & " > " & sShellRndTmpFile, 7, True 

请参阅Microsoft帮助中使用的WScript run方法。

问候

Ytracks

的[要隐藏命令提示窗口使用WshShell.Exec方法]