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.
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
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