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 strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

vbs with excel: connections?

Status
Not open for further replies.

guif

Programmer
Sep 6, 2007
27
ES
Hi!
I have a file Excel with a lot of IP's in A1 to A20.
I would like to put a code into the B2 to B20 to know the conexion is OK or no OK.
IT's possible to make some ping's???

For example

A B
1 PC_1 OK
2 PC_2 NO OK
3 PC_3 OK

thank's!
 
You could have a function:
Code:
Function chkIP(r)
 chkIP = "OK"
 rc = Shell("ping " & r.Value, vbHide)
 If rc = 0 Then chkIP = "Not OK"
End Function


_________________
Bob Rashkin
 
Actually, on second thought ping won't work since it returns a successful code even if the connection times out. You need to find a shell command that succeeds if the the connection is valid and fails if it isn't. I guess it would depend on what kind of interface the IP nodes support.

_________________
Bob Rashkin
 
That is why I suggested the API, a proven technique when desiring to Ping via VBA. ;)

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci
 
but i can't put colors in my columms?
 
sorry! i would like to put the result in the colum B2 (for example)
 
I don't understand what your asking. The API that firefytr provided includes a function you can use to check the IP connection. If that function is in, say, a module, you can use it on your spreadsheet in any cell you want to.

_________________
Bob Rashkin
 
oh sorry! my english is very bad.

See this example:


This is my Excel. In ESTAT i would like to put the macro. If the IP is ok the colum of ESTAT is green. If the IP is not OK the colum of ESTAT is red.
 
Look at the links I posted. The VBnet link with code by Randy Birch has a very nice userform, along with all the necessary code and instructions. You need to help yourself, we cannot do it for you. We can only point you the way. :)

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci
 
ok. i go to see (another time) the links.
but.. i have this code:

set colItems = objWMIService.ExecQuery ("Select * from Win32_PingStatus " & "Where Address = '" & Cell & "'")
for each objItem in colItems
if objItem.StatusCode = 0 Then
objWorksheet.Cells(Cell.Row, Cell.Column 6).font.color = rgb(0,128,0)
objWorksheet.Cells (Cell.Row, Cell.Column 6) = "OK"
Else
objWorksheet.Cells(Cell.Row, Cell.Column 6).font.color = rgb(255,0,0)
objWorksheet.Cells (Cell.Row, Cell.Column 6) = "No ok"
end If
Next
End Sub

is it right for me?
 
dunno - try running it and finding out...

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
 
i don't say to where put the code...
 
WOW!!!

I make a VBscript that it read an excel.
It put the color green or red for the diferent case.
This is the code:


strFitxer="D:\armaris\armaris.xls"
Dim IP
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.open strFitxer
objExcel.sheets("ARMARIS").Activate
objExcel.ActiveSheet.range("E3").Activate

Set wshShell = CreateObject("WScript.Shell")
Do While objExcel.activecell.Value <> ""
IP = objExcel.activecell.Value
Ping = WshShell.Run("ping -n 4 " & IP, 0, True)
Select Case Ping
Case 0 objExcel.activecell.offset(0,1).Value = "On Line"
objExcel.activecell.offset(0,1).Interior.ColorIndex = 4
Case 1 objExcel.activecell.offset(0,1).Value = "Off Line"
objExcel.activecell.offset(0,1).Interior.ColorIndex = 3
End Select
objExcel.activecell.offset(1, 0).Activate
Loop
[/CODE]

another question...
It's possible to put a button near the row IP to launch a msdos windows to make a "ping -t"??

thank you very much!
 
Maybe instead the following adjusted using windows shell instead of api..

Code:
Option Explicit

Sub sdfljd()
    
    Dim WshShell As Object
    Dim objExcel As Excel.Application, xlBook As Excel.Workbook, xlSheet As Excel.Worksheet
    Dim IP As Variant, Ping As Long, i As Long, iEnd As Long, iTotal As Long
    Dim blnCreatedXL As Boolean, blnOpenedXlBook As Boolean
    Dim strFitxer As String, strName As String
    
    strFitxer = "D:\armaris\armaris.xls"
    strName = Right(strFitxer, Len(strFitxer) - InStrRev(strFitxer, "\"))
    Set objExcel = GetObject(, "Excel.Application")
    If objExcel Is Nothing Then
        blnCreatedXL = True
        Set objExcel = CreateObject("Excel.Application")
    End If
    On Error Resume Next
    If Len(objExcel.Workbooks(strName).Name) = 0 Then
        Set xlBook = objExcel.Workbooks.Open(strFitxer)
        blnOpenedXlBook = True
    Else
        Set xlBook = objExcel.Workbooks(strName)
    End If
    Set xlSheet = xlBook.Sheets("ARMARIS")
    iEnd = xlSheet.Cells(xlSheet.Rows.Count, "E").End(xlUp).Row
    iTotal = iEnd - 2
    Call ToggleEvents(False)
    Set WshShell = CreateObject("WScript.Shell")
    For i = 3 To iEnd
        IP = xlSheet.Cells(i, "E").Value
        Application.StatusBar = "Pinging " & i - 2 & " of " & iTotal & " - " & Format((i - 2) / iTotal, "Percent") & " ... " & IP
        Ping = WshShell.Run("ping -n 4 " & IP, 0, True)
        Select Case Ping
        Case 0
            xlSheet.Cells(i, "F").Value = "On Line"
            xlSheet.Cells(i, "F").Interior.ColorIndex = 4
        Case 1
            xlSheet.Cells(i, "F").Value = "Off Line"
            xlSheet.Cells(i, "F").Interior.ColorIndex = 3
        End Select
    Next i
    If blnCreatedXL = True Then
        objExcel.Quit
    Else
        If blnOpenedXlBook = True Then
            xlBook.Close savechanges:=True 'false
        End If
    End If
    Call ToggleEvents(True)
    
End Sub

Sub ToggleEvents(blnState As Boolean)
'Originally written by firefytr
    With Application
        .DisplayAlerts = blnState
        .EnableEvents = blnState
        .ScreenUpdating = blnState
        If blnState Then .CutCopyMode = False
        If blnState Then .StatusBar = False
    End With
End Sub

HTH

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci
 
I put this code into the editor of VBasic in Excel.
The code is not running... why?
 
Hmm, well it works for me, so I'm not sure what you're doing. It goes into a standard module. Try stepping through it with F8 and observing each line execution.

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci
 
where I put this code? into a VBA in excel or in a VBS?
Can you send me your file to see this buttons???
 
From within Excel, press Alt + F11 to open the Visual Basic Editor. Press Ctrl + R to open the Project Explorer. Double click your file/project on the left pane (the Project Explorer). Click the Insert menu, select Module (standard module). Paste the code I posted in that module. Save the file before you run. Close the VBE. You can run the code by pressing Alt + F8 from within Excel, which brings up the Macros dialog box, select sdfljd, or whatever you named the routine, and click Run.

HTH

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top