Question

我正在针对用户选择的服务器IP执行快速PING以确认它是可访问的。

以下代码正是我所需要的，除了我想避免命令Shell窗口的快速闪存。

我需要修改什么来最小化那个讨厌的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

Answer 1

这个问题可能有点旧，但我认为这个答案仍然可以提供帮助。（使用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

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

如果您需要有关API如何运作的更多信息，快速谷歌搜索将为您提供大量信息。

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

Answer 2

找到了一种非常可行且无声的方法：

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

Answer 3

wscript的run方法已经包含了最小化运行的参与者。因此，如果没有上面显示的所有努力，只需使用

旧代码

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

新代码

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

请参阅Microsoft帮助以在wscript中使用run方法。

问候

Ytracks

WScript命令 - 运行最小化？（MS Access / VBA）

3 个答案:

WScript命令 - 运行最小化？ （MS Access / VBA）

3 个答案:

WScript命令 - 运行最小化？（MS Access / VBA）