2013-10-03 71 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方法]