Reliable send keys

[AltaEgo]

Hello

I use the code below to open and run ipconfig /all to file. It woks fine on
my laptop but is hit-and-miss on other laptops, sometimes running; sometimes
producing Enter only; sometimes nothing more than the open cmd window. Is
there a way to ensure the code does its job? I was thinking of While Dir
produces nothing and shortening the wait time but the thought of the
SendKeys disappearing into buffers or elsewhere worries me - running the
code in break mode experience Is there another way?


Sub RunCMD()
Dim ReturnValue

sCmd = "ipconfig /all > " & ActiveWorkbook.Path & "\" & fName & " {ENTER}"

ReturnValue = Shell("CMD.EXE", 1)

' possibly, While the file doesn't exist
Application.OnTime Now + TimeSerial(0, 0, 5), "typeKeys" ' reduce 5 to 1?
'Wend
End Sub



Private Sub typeKeys()
SendKeys sCmd
End Sub

 

[Steve Yandl]

Steve,

Here is an alternate approach which is a VBA adaption of a vbScript I use.
In the example, I simply have the output placed on the active sheet in
Column A beginning at row 1 but that is all pretty easy to modify.

'--------------------------------------
Sub RunIPCONFIG()
Dim r As Integer
Dim strLine As String
Set wsh = CreateObject("WScript.Shell")
Set wshExec = wsh.Exec("ipconfig /all")
Set objStdOut = wshExec.StdOut
r = 1

Do Until objStdOut.AtEndOfStream
strLine = objStdOut.ReadLine
Cells(r, 1).Value = strLine
r = r + 1
Loop

Set wshExec = Nothing
Set wsh = Nothing
End Sub


'--------------------------------------

Steve Yandl

 

[Peter T]

SendKeys is unreliable at the best of times and even more dodgy with the
command window. Why not pipe the results of ipconfig to a text file with the
Shell (and use vbHide), then open the text file in notepad or even directly
into cells. Post back if not sure how to do that.

Regards,
Peter T

 

[AltaEgo]

Thank you. If you mean along the lines of Steve Yandl's reply, I tried
something similar before asking the question. It worked great on my home PC
but failed to run on the laptops that require audit. These are locked down
tight.

I since discovered the precise moment the code was passed by watching the
Excel status bar when the cmd window (supposedly) had focus. This led to me
touching the cmd window with the mouse before it fired (why is that not a
logical step <g>). This made the command pass every time. So, this issue
seems to be that the cmd window is either not achieving focus or is losing
focus - despite outward appearances. I guess the next logical question is
how to check whether cmd has focus and switch focus if it does not have it.

 

[AltaEgo]

Thank you. I am sure I tried something similar before asking the question.
The laptops seem to have scripting locked on user accounts. I need to run
the audit from user logon ... I plan to try again with your code on the slim
chance I did something wrong before.

 

[Peter T]

The WScript approach would be simplest providing it is available, which it
isn't always in corporate systems. But I wasn't suggesting that, if you
re-read.

Regards,
Peter T

 

[AltaEgo]

If that is not what you meant, I am in need of enlightenment on piping to
file (temp.txt) using Shell. From there, I am already reading the result and
appending required data to rows.

 

[Peter T]

Try something like this -

Sub GetIPconfig()
Dim bGotIt As Boolean
Dim ret As Long
Dim t As Single
Dim sCmd As String
Dim sFile As String
Const Q As String = """"
Const timeOut As Single = 5

sFile = Application.DefaultFilePath & "\ipConfig.txt"
sCmd = "cmd.exe /k ipconfig.exe /all >"
On Error Resume Next
Kill sFile
On Error GoTo 0

ret = Shell(sCmd & Q & sFile & Q, vbHide)

' loop until the file exists or time-out
t = Timer + timeOut
Do
bGotIt = FileExists(sFile)
Loop While Not bGotIt And t > Timer

If bGotIt Then
MsgBox "Got ipConfig" ' hmm, seem to need a little break here
FileToCells sFile, Range("A1")
Kill sFile
Else
MsgBox "failed !"
End If

End Sub

Private Function FileExists(ByVal sFile As String) As Boolean
Dim nAttr As Long

On Error Resume Next
nAttr = GetAttr(sFile)
FileExists = (Err.Number = 0) And ((nAttr And VBA.vbDirectory) = 0)
On Error GoTo 0

End Function

Sub FileToCells(sFile As String, rng As Range)
Dim nLen As Long
Dim sTxt As String
Dim FF As Integer
Dim arr

FF = FreeFile
Open sFile For Binary Access Read As #FF
nLen = LOF(FF)
'if nlen = 0 then ?
sTxt = String(nLen, 0) '
Get FF, , sTxt
Close FF

sTxt = Replace(sTxt, vbCr, "")
arr = Application.Transpose(Split(sTxt, vbLf))

rng.Resize(UBound(arr)).Value = arr

End Sub

For some reason seem to need to break the code before getting the textfile,
not sure why, probably missing something simple.

Regards,
Peter T

If that is not what you meant, I am in need of enlightenment on piping to
file (temp.txt) using Shell. From there, I am already reading the result
and appending required data to rows.

 

[AltaEgo]

That code is grabbing it on my home PC ...
Well, it did when I added debug.Print Dir(sFile) within the FileExists
function.

The following modification made it reliable. Despite the modification
allowing the system to see that the file existed it still managed to hang
occasionally on the Kill sFile after MsgBox "Got ipConfig". Following the
code, this seems to defy logic. A inverted comma worked around that (but
leaves me scratching my head). For some reason or other, I also found the
code that writes to sheet fell over occasionally before commenting out the
Kill sFile line. {while discovered in this order, those points should have
been written the other way around in order of the process ... it was a long
day}


Private Function FileExists(ByVal sFile As String) As Boolean

Dim sTmp As String
On Error Resume Next

sTmp = Dir(sFile)

FileExists = (Err.Number = 0) And Len(sFile) > 1
On Error GoTo 0

End Function

 

[AltaEgo]

Peter,
Thank you. I now have it working reliably on one of the laptops.

In a flash of inspiration (OK, after a good night's sleep, some thought and
experimentation), I figured out the erratic behaviour. The file is created
straight away but not written until data are retrieved by ipconfig. A check
of file length as below ensures we have data.

Happy to receive an recommendations for improvement...

Private Function FileExists(ByVal sFile As String, Optional tryTime As
Single) As Boolean
' tryTime - Rugby League season is here!
' OR maximum time to allow for looping

Dim t, lsize

t = Timer + tryTime

On Error Resume Next

Do
lsize = FileLen(sFile)

If lsize > 0 Then FileExists = True

Loop Until lsize > 0 Or t < Timer

On Error GoTo 0

End Function

 

[AltaEgo]

Odd, I saw the following in my sent items but it doesn't appear in my
message list. I apologise if it is a repeat.

Peter,
Thank you. I now have it working reliably on one of the laptops.

In a flash of inspiration (OK, after a good night's sleep, some thought and
experimentation), I figured out the erratic behaviour. The file is created
straight away but not written until data are retrieved by ipconfig. A check
of file length as below ensures we have data.

Happy to receive an recommendations for improvement...

Private Function FileExists(ByVal sFile As String, Optional tryTime As
Single) As Boolean
' tryTime - Rugby League season is here!
' OR maximum time to allow for looping

Dim t, lsize

t = Timer + tryTime

On Error Resume Next

Do
lsize = FileLen(sFile)

If lsize > 0 Then FileExists = True

Loop Until lsize > 0 Or t < Timer

On Error GoTo 0

End Function

 

[Peter T]

I only see your message as quoted below starting "Odd"

Yes, better to wait until the FileLen is returned rather than an empty file.
But something's still puzzling me. With my original code, if I manually and
quickly dismiss the msgbox all works fine in under 1 second. With the
revised FileLen check and no msgbox it's taking about 4 seconds.

However if I change the windowstyle argument in the Shell from vbHide to
vbMinimizedFocus (default) it now takes about two seconds (although the
command window appears in the taskbar during that period). OK better, but
still much slower than momentarily showing the msgbox.

It's probably better to change the /k switch in the cmd string to /c, though
I'm not sure it actually makes any difference.

For others looking at this, referring to my original change simply replace
the Do - While Loop with this one

t = Timer + timeOut
On Error Resume Next
Do
bGotIt = FileLen(sFile) > 0
Loop While Not bGotIt And t > Timer
On Error GoTo 0

Experiment with vbHide & vbMinimizedFocus, and /k & /c

Peter T

 

[Peter T]

PS,

For others looking at this, etc

.... and comment the msgbox

Peter T

 

[AltaEgo]

Than you again. I will play with the switches, vbHide and vbMinimizedFocus
at my leisure although, when running gpresult /R a second or two won't make
much difference. I find the need to allow 60 seconds to ensure this one
runs.

 

[Peter T]

What, 60 seconds just to complete ipconfig, surely not ...

Regards,
Peter T

 

[AltaEgo]

ipconfig is running relatively fast. It is gpresult that needs the time.
Normally it gets the job done reasonably fast but I had to set 80 seconds to
be sure for those occasions when the system is bogged down with startup,
update, policy ...