Http Request Repsonse Query

Hello Killavirus,

This macro will look for URLs on the ActiveSheet starting at cell "A2". Each URL will be pinged an the results place in column "B" of same row.

'Written: May 26, 2008
'Author:  Leith Ross
'Summary: Pings a IP adress a requested number of times with a specified
'         time out interval. The functions returns a variant string array
'         with results of the Ping command.


Private Function GetPingData(ByVal IP_Address As String, ByVal Ping_Count As Integer, ByVal Timeout As Integer) As Variant

  Dim CmdLine As String
  Dim PingData As String
  Dim PingReturn As Object
  Dim WSH As Object
  
   'Create the Cmd.exe command line string
    CmdLine = "cmd.exe /c ping " & IP_Address & " -n " _
            & CStr(Ping_Count) & " -w " & CStr(Timeout)
    
   'Launch Cmd.exe and Ping the IP address
    Set WSH = CreateObject("WScript.Shell")
    Set PingReturn = WSH.Exec(CmdLine)
    
     'Wait until the Ping process is finished
      While PingReturn.Status = 0
        DoEvents
      Wend
      
     'Remove Carraige Returns from the data
      PingData = PingReturn.StdOut.ReadAll
      PingData = Replace(PingData, vbCr, "")
    
     'Split data into individual lines
      GetPingData = Split(PingData, vbLf)
        
End Function

Public Sub PingAddresses()

  Dim LastRow As Long
  Dim N As Integer
  Dim PingCount As Integer
  Dim PingData As Variant
  Dim R As Long
  Dim StartCol As Variant
  Dim StartRow As Long
  Dim Timeout As Integer
  
    PingCount = 4     'Number of time to ping the address
    Timeout = 1000    'Milliseconds before timeout occurs
    StartCol = "A"    'Starting column of IP addresses
    StartRow = 2      'Starting row of IP addresses
    
     'Calculate the number of lines to be returned
      N = 8 + PingCount - 1
      
     'Determine the row with the last IP address
      LastRow = Cells(Rows.Count, StartCol).End(xlUp).Row
    
      For R = StartRow To LastRow
       'Trap error if there was no response
        PingData = GetPingData(Cells(R, StartCol), PingCount, Timeout)
        On Error Resume Next
          Cells(R, StartCol).Offset(0, 1) = PingData(N)
          If Err.Number <> 0 Then
            Cells(R, StartCol).Offset(0, 1) = PingData(N - 2)
            Err.Clear
          End If
        On Error GoTo 0
      Next R
  
End Sub

Adding the Macro

1. Copy the macro above pressing the keys CTRL+C
2. Open your workbook
3. Press the keys ALT+F11 to open the Visual Basic Editor
4. Press the keys ALT+I to activate the Insert menu
5. Press M to insert a Standard Module
6. Paste the code by pressing the keys CTRL+V
   
7. Make any custom changes to the macro if needed at this time.
8. Save the Macro by pressing the keys CTRL+S
9. Press the keys ALT+Q to exit the Editor, and return to Excel.

To Run the Macro...
To run the macro from Excel, open the workbook, and press ALT+F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

looks Awesome !!!

doubt i will be able to rely on pings though due to if the IIS server crashes it would still return a ping, ill be trying with http get commands but see'ing how to implement cmd prompts i should be ok but will post updates seeing how i get on !!