'WMI - Easy Shutdown
'If you have gotten tired of having to click several items just to
'shutdown your PC or laptop, save this script to a .vbs file and
'create an icon for it.   It will shutdown your machine with just
'one click.   No prompts, no waiting, just power down.  
'I've also included a few of the other constants just in case you need a slight variation.
Sub ForceReBoot()
   nLogOff                = 0     'Alternative actions to force reboot
   nReboot               = 2
   nForceLogOff         = 4
   nForceReboot        = 6
   nPowerDown         = 8
   nForcePowerDown = 12
   Set oOS = GetObject("winmgmts:{(Shutdown)}").ExecQuery("Select * from Win32_OperatingSystem")
   For Each oOperatingSystem in oOS
      oOperatingSystem.Win32Shutdown(nForceReboot)
   Next
End sub' ForceReBoot
 
Sub SleepDelay ()
For i = 1 to 5
'  Wait 10 seconds (1000ms = 1 second)
   Wscript.Sleep 10*(1000)
Next 'i
 
End Sub 'SleepDelay

Private Type ty_s_PC_Properties
    g_numb As String
    ip_add As String
    status As String
End Type

'this sub calls the above function using a for each loop
Sub GetIPStatus()
    
    'declaring variables
    Dim Cell As Range
    Dim ipRng As Range
    Dim Result As String
    Dim objPC As ty_s_PC_Properties
    Dim Wks As Worksheet
    Dim StartTime As Double
    Dim SecondsElapsed As Double
    
    'this clears the current Ping Status column (not necessary but visually helpful
    Worksheets("List2").Range("B2:B10000").Clear
    
    'this starts a time to see how long the status check takes
    StartTime = Timer
    
    'setting values of variables
    Set Wks = Worksheets("List2")
    Set ipRng = Wks.Range("A2")
    Set RngEnd = Wks.Cells(Rows.Count, ipRng.Column).End(xlUp)
    Set ipRng = IIf(RngEnd.Row < ipRng.Row, ipRng, Wks.Range(ipRng, RngEnd))
    
    
    'this is a loop that feeds each server from the list into the GetPingResult function
    For Each Cell In ipRng
        objPC = GetPingResult(Cell)
        Cell.Offset(0, 1) = objPC.ip_add
        Cell.Offset(0, 2) = objPC.status
    Next Cell
    
    'this calculates the time it took to run the script and converts it to minutes
    SecondsElapsed = Round(Round(Timer - StartTime, 2) / 60)
    
    'this displays the final time taken and lets the user know everything has completed
    MsgBox "This code ran successfully in " & SecondsElapsed & " minutes", vbInformation
 
End Sub

'This function does the pinging
Private Function GetPingResult(Host) As ty_s_PC_Properties
   
    'declaring variables
    Dim objPing As Object
    Dim objStatus As Object
    Dim objResult As ty_s_PC_Properties 'String
    
    'ping the host
    Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
                            ExecQuery("Select * from Win32_PingStatus Where Address = '" & Host & "'")
    
    'report the results
    For Each objStatus In objPing
        ' --
        With objResult
            .g_numb = Host
            .ip_add = objStatus.ProtocolAddress
            .status = getStatusCode(objStatus.StatusCode)
        End With
        ' --
        GetPingResult = objResult 'strResult
    
    Next
    
    'reset object ping variable
    Set objPing = Nothing
 
End Function

Private Function getStatusCode(StatusCode) As String
    Dim strResult As String
    
    '---
    Select Case StatusCode
        Case 0: strResult = "Connected"
        Case 11001: strResult = "Buffer too small"
        Case 11002: strResult = "Destination net unreachable"
        Case 11003: strResult = "Destination host unreachable"
        Case 11004: strResult = "Destination protocol unreachable"
        Case 11005: strResult = "Destination port unreachable"
        Case 11006: strResult = "No resources"
        Case 11007: strResult = "Bad option"
        Case 11008: strResult = "Hardware error"
        Case 11009: strResult = "Packet too big"
        Case 11010: strResult = "Request timed out"
        Case 11011: strResult = "Bad request"
        Case 11012: strResult = "Bad route"
        Case 11013: strResult = "Time-To-Live (TTL) expired transit"
        Case 11014: strResult = "Time-To-Live (TTL) expired reassembly"
        Case 11015: strResult = "Parameter problem"
        Case 11016: strResult = "Source quench"
        Case 11017: strResult = "Option too big"
        Case 11018: strResult = "Bad destination"
        Case 11032: strResult = "Negotiating IPSEC"
        Case 11050: strResult = "General failure"
        Case Else: strResult = "Unknown host"
    End Select
    
    '---
    getStatusCode = strResult
    
End Function