CreateObject minimised

[Snypa]

Hello,



I have the following code:

        For Each tmpCell In Range("F8:F14")
            With tmpCell
                If .Value <> "" Then
                    status = CreateObject("WScript.Shell").Exec("%comspec% /c Ping -4 -n 1 -w 750 " & .Value).StdOut.ReadAll
                    If InStr(status, "TTL=") Then
                        .Interior.ColorIndex = 4
                    Else
                        .Interior.ColorIndex = 3
                    End If
                End If
            End With
        Next

This causing an array of command prompts to appear and disappear over the spread sheet. Is there a way for this to be less intrusive? Such as starting the windows minimized or, ideally, not even showing them at all?


Any help will be greatly appreciated.


Thanks,

 

[JackDanIce]

This link may help: https://stackoverflow.com/questions/32297699/hide-command-prompt-window-when-using-exec

 

[Snypa]

Thank you for this. I used the following:

If WScript.Arguments.Named.Exists("signature") Then WshShellExecCmd
                    strCmd = "%comspec% /c Ping -4 -n 1 -w 750 " & .Value
                    RunCScriptHidden
                    WScript.Echo strRes

But I get a Variable not defined error on WScript. the full code I copied from is here: https://stackoverflow.com/a/32302212

I have just realised, this is for VBSript not VBA.

 

[JackDanIce]

Untested, apart from code change, edit for CreateObject highlighted, see if this is less intrusive:

Sub test()

    Dim rng     As Range
    Dim r       As Range
    Dim rngBlnk As Range
    Dim status  As Variant
    
    Set rng = Cells(8, 6).Resize(7)
    rng.Interior.ColorIndex = 3
    
    On Error Resume Next
    Set rngBlnk = rng.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    
    If Not rngBlnk Is Nothing Then
        For Each r In rngBlnk
            If InStr(CreateObject("WScript.Shell").Exec("%comspec% /c /Q Ping -4 -n 1 -w 750 " & r.Value).StdOut.ReadAll, "TTL=") Then r.Interior.ColorIndex = 4
        Next r
        Set rngBlnk = Nothing
    End If
    
    Set r = Nothing
    
End Sub

 

[Snypa]

Thank you.

I got this working:

Private Sub CommandButton1_Click()

        For Each tmpCell In Range("F8:F14")
            With tmpCell
                If .Value <> "" Then
                    CreateObject("WScript.Shell").Run "%comspec% /c Ping -4 -n 1 -w 750 " & .Value & " | clip", 0, True
                    

                    strOutput = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
                    
                    If InStr(strOutput, "TTL=") Then
                        .Interior.ColorIndex = 4
                    Else
                        .Interior.ColorIndex = 3
                    End If
                End If
            End With
        Next
        
End Sub

It doesn't show the windows anymore but it does make excel unusable for 3-5 seconds while it runs the code. Does anyone know of a way to avoid this? It's a long shot but hey.

 

[JackDanIce]

Hopefully that has resolved issue for you?

You can make that run a little faster by

#1 colour all cells F8:F14 with index 3
#2 using the .SpecialCells(xlCellTypeBlanks) property to reduce the number of cells you're testing for TLL= inside the loop and then only colouring them index 4

Without knowing how intrusive it is, much of what I've suggested is without testing or where I have tested, it's not been noticable for me.

 

[Snypa]

Where would I put the .SpecialCells() method, After Range()?

 

[JackDanIce]

See post #4