Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

shell(cmd) works in debug, but not from cmdButton 1

Status
Not open for further replies.

Divercem

IS-IT--Management
Apr 2, 2007
39
US
I have the following vba code in an Excel spreadsheet with a cmdButton. When I click on the cmdButton I get an error that the file to be opened does not exist. When I step through in debug mode the file is created.

I'm using the redirect output character ">" in the shell(cmd) which should create the file.

Code:
Option Explicit
Private Sub cmdGetIP_Click()
    On Local Error GoTo ShellDOS_Exit_Err
    Dim TaskID As Integer, intInput As Integer, valRow As Integer, valBracket As Integer
    Dim valDelay As Integer
    Dim strBuffer As String, strIPaddress As String
    Dim exeDrive As String, exeFolder As String, exeText As String, exePath As String, exeCMD As String
' Rename WorkSheet Reference Names by clicking on Properties Window icon on Tool bar & changing (Name)
' Rename WorkSheet Tab by changing Name on Properties page or right-clicking tab & Rename
    Application.StatusBar = "Get Tulsa IP Info"
'    Application.ScreenUpdating = False                  ' Don't need to see the fields as they populate
    sTulsaIPs.Activate                                  ' Activate Mailboxes tab to write data
    exeDrive = "C:\"
    exeFolder = "Scripts"
    exeText = "TulsaIP.txt"
    exePath = exeDrive & exeFolder & "\"
    For valRow = 2 To 512                               ' Subnet 255.255.254.0
        strIPaddress = sTulsaIPs.Cells(valRow, 1) & "." & sTulsaIPs.Cells(valRow, 2) & _
            "." & sTulsaIPs.Cells(valRow, 3) & "." & sTulsaIPs.Cells(valRow, 4)
'        exeCMD = "cmd /c ping -n 1 -a " & strIPaddress & " >C:\Scripts\TulsaIP.txt"
        exeCMD = "cmd /c ping.exe -n 1 -a " & strIPaddress & " >" & exePath & exeText
        TaskID = Shell(exeCMD, vbHide)
'        For valDelay = 1 To 5000
'        Next valDelay
        If TaskID > 0 Then
            Application.StatusBar = "Get Tulsa IP Info - " & strIPaddress
            intInput = FreeFile
            Open exePath & exeText For Input As #intInput   ' Open the Input file
            Do Until EOF(intInput)                          ' Loop through the Input file
                Line Input #intInput, strBuffer             ' Get a line from the temp file
                valBracket = 0
                Select Case Left(strBuffer, 8)
                    Case ""                                 ' Blank Line
                    Case "Pinging "                         ' Pinging - if [ is present, disp DNS name
                        valBracket = InStr(1, strBuffer, " [", vbTextCompare)
                        If valBracket > 0 Then
                            sTulsaIPs.Cells(valRow, 5) = Mid(strBuffer, Len("Pinging ") + 1, valBracket - Len("Pinging "))
                        Else
                            sTulsaIPs.Cells(valRow, 5) = "" ' No [ present - no DNS Name
                        End If
                    Case "Reply fr"                         ' Reply from
                        sTulsaIPs.Cells(valRow, 6) = "Online"
                        Exit Do
                    Case "Request "                         ' Request Timed Out
                        sTulsaIPs.Cells(valRow, 6) = "Request Timed Out"
                        Exit Do
                    Case "Ping Sta"                         ' Ping Statistics
                        Exit Do
                    Case Else
                End Select
            Loop
'   Close both files
            Reset
        End If
'        For valDelay = 1 To 5000
'        Next valDelay
    Next valRow
ShellDOS_Exit_End:
    
' Delete the file you have sent
'    Kill exePath & exeText
    Kill "C:\Scripts\TulsaIP.txt"
    Application.StatusBar = ""
    Exit Sub
ShellDOS_Exit_Err:
    MsgBox Error$
    Application.StatusBar = ""
End Sub

Something else that is curious to me is that when there is a blank line in the input file, it loops through 2 times for every blank line.

Thanks for your help.

Charlie
 
If the button is form the controls toolbox, try setting the "Take Focus On CLick" property to false

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question
 
That did the trick. Sorry for the delay. We're changing domains, IP networks, email servers and telephones...this is the first chance I have had to try your suggestion.

Thanks,

Charlie
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top