Excel VBA (WMI script to restart list of servers)

' Excel vba script WMI script which restarts list of server and wait to come back & capture the what all services are running & pulls out the status & then move to next server..

Option Private Module
Option Explicit

Global i, j, strQuery, serverName, isAvailable, SystemOnline, ChkCount, objWMIService, colItems, objItem, cmd
Global rCount, lRow, mSht, oSht, OtlApp, statusWb, NewMl, emailID, wTime, arrService(), serviceName, serviceStat
Global shtRng As Range
Sub check_service_status()

With ThisWorkbook
    wTime = Trim(.Sheets("Main").Range("L6"))
    emailID = Trim(.Sheets("Main").Range("L2"))
    If wTime = vbNullString Then
         MsgBox "server wait time cannot be blank..", vbOKOnly + vbInformation, "blank server wait time"
        .Sheets("Main").Range("L6").Activate
         Exit Sub
    End If
    Set mSht = .Sheets("ServerName & ServiceName")
    Set oSht = .Sheets("Output")
    lRow = mSht.Cells(mSht.Rows.Count, 10).End(xlUp).Row
    ReDim arrService(1 To lRow, 1 To 1)
    Set shtRng = mSht.Range("J2:J" & lRow)
    arrService = shtRng
    wTime = CInt(IIf(wTime = 0, 1, wTime))
End With

'oSht.Activate
oSht.Rows("2:" & oSht.Rows.Count).ClearContents
'oSht.Range("D:D").Interior.Color = xlNone
mSht.Range("B2:C" & 1048576).ClearContents

lRow = mSht.Cells(mSht.Rows.Count, 1).End(xlUp).Row

rCount = 2

For i = 2 To lRow
    ChkCount = 1
    serverName = mSht.Cells(i, 1)
    mSht.Cells(i, 2) = Time
    Call Server_Available
    If isAvailable = True Then
                                        '''''''''''''''' send a message to restart the computer and wait for a 60 seconds
        cmd = Shell("SHUTDOWN /r /f /t 60 /m \\" & serverName & " /c " & """The computer will restart in next 60 seconds, please save all work.""", vbHide) '''''''''''''''''' command to restart the remote machine ''''''''''''
        Application.Wait Now + TimeValue("00:00:10")
        Call Server_Available
        If isAvailable = True Then
            Call Capture_Service_Status
        End If
    End If
    mSht.Cells(i, 3) = Time
Next

If emailID <> vbNullString Then Call Send_StatusReport
ThisWorkbook.Save
End Sub
Sub Server_Available()

isAvailable = False

' Define the WMI query
strQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & serverName & "'"

' Run the WMI query
Set colItems = GetObject("winmgmts://./root/cimv2").ExecQuery(strQuery)

' WMI query result loop
For Each objItem In colItems
    If Not IsObject(objItem) Then
        SystemOnline = False
    ElseIf objItem.StatusCode = 0 Then
        isAvailable = True
    Else
        isAvailable = False
    End If
Next
''''''''''''''''''''''''''''''' check whether the server is available for ping/login
If isAvailable = False And ChkCount <= ((wTime * 60) / 30) Then
    ChkCount = ChkCount + 1
    Application.Wait Now + TimeValue("00:00:30")
    Call Server_Available
ElseIf ChkCount > ((wTime * 60) / 30) Then        ''''''''''''''''''''''''''''''''''''''' if server not available after 600 seconds then update the sheet
    oSht.Cells(rCount, 1) = serverName
    oSht.Cells(rCount, 2) = "No"
    oSht.Cells(rCount, 3) = "Permission denied"
    oSht.Cells(rCount, 4) = "Permission denied"
    'oSht.Cells(rCount, 4).Interior.ColorIndex = 15
    rCount = rCount + 1
End If
End Sub
Sub Capture_Service_Status()

For j = 1 To UBound(arrService)
    Set objWMIService = GetObject("winmgmts:\\" & serverName & "\root\CIMV2")
    Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Service", , 48)
    serviceName = vbNullString
    serviceStat = vbNullString
    For Each objItem In colItems
        If UCase(Trim(objItem.Name)) = UCase(Trim(arrService(j, 1))) Then
            serviceName = objItem.Name
            serviceStat = objItem.State
            Exit For
        End If
    Next
        oSht.Cells(rCount, 1) = serverName
        oSht.Cells(rCount, 2) = "Yes"
        oSht.Cells(rCount, 3) = arrService(j, 1)
        oSht.Cells(rCount, 4) = IIf(serviceStat <> vbNullString, serviceStat, "Service not exists")
        'If LCase(serviceStat) = "running" Then
            'oSht.Cells(rCount, 4).Interior.ColorIndex = 43
        'Else
            'oSht.Cells(rCount, 4).Interior.ColorIndex = 3
        'End If
        rCount = rCount + 1
        Set objItem = Nothing
        Set colItems = Nothing
        Set objWMIService = Nothing
Next j
End Sub
Sub Send_StatusReport()

    On Error Resume Next
    Set OtlApp = GetObject(, "outlook.application")

    If Err.Number = 429 Then
        Err.Clear
        Shell "outlook.exe", vbMaximizedFocus
        Set OtlApp = GetObject("", "outlook.application")
    End If

    oSht.Copy
    Set statusWb = ActiveWorkbook
    statusWb.SaveAs ThisWorkbook.Path & "\Service_StatusReport.xlsb", xlExcel12
    statusWb.Close True

    Set NewMl = OtlApp.createitem(0)
    With NewMl
        .To = emailID
        .Subject = "Service Status Report"
        .body = "Please find attached Service Status Report"
        .Attachments.Add ThisWorkbook.Path & "\Service_StatusReport.xlsb"
        .display
        .send
    End With

Application.Wait Now + TimeValue("00:00:10")

Set statusWb = Nothing
Set NewMl = Nothing
OtlApp.Quit
Set OtlApp = Nothing

'' delete the stauts file after send
Kill ThisWorkbook.Path & "\Service_StatusReport.csv"
End Sub