WScript Command - Run Minimized? (MSAccess/VBA)

Question

I am performing a quick PING against the user-selected server IP to confirm it is reachable.

The following code does exactly what I need, except I would like to avoid the quick flash of the Command Shell window.

What do I need to modify to minimize that pesky CMD window?

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

the run method of wscript already contains argumewnts to run minimized. So without all that effort shown above simply use

old code

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

new code

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

see Microsoft help for using the run method in wscript.

regards

Ytracks

Answer 2

This question may be a little old but I figure that this answer may still be able to help. (Tested with Excel VBA, have not been able to test with Access)

The WshShell.Exec Method enables the use of .StdIn, .StdOut, and .StdErr functions to write to and read from the consol window. The WshShell.Run Method does not allow this functionality so for some purposes using Exec is required.

While it's true that there is no built in function to start the Exec method minimized or hidden you can use API's to quickly find the Exec window hwnd and minize/hide it.

My below script takes the ProcessID from the Exec object to find the window's Hwnd. With the Hwnd you can then set the window's show state.

From my testing with Excel 2007 VBA, in most cases I never even see the window... In some cases it might be visible for a few milliseconds but would only appear a quick flicker or blink... Note: I had better results using SW_MINIMIZE than I did with SW_HIDE, but you can play around with it.

I added the TestRoutine Sub to show an example of how to use the 'HideWindow' function. The 'HideWindow' function uses the 'GetHwndFromProcess' function to get the window hwnd from the ProcessID.

Place the below into a Module...

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 function: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633548%28v=vs.85%29.aspx

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

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

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

If you need more information on how the API's work, a quick google search will provide you with a ton of information.

I hope that this can help... Thank You.

Answer 3

Found a very workable and silent approach:

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