Function LocalAdmins_AuditorEx(objBook, strAdmins)
Dim objWsNet, strDomain
Dim objTemp, strTemp, arrTemp, blnModify, strAdmins2, strListFull, intRes
Dim strListRemoved, strListNotRemoved, strListAdded, strListNotAdded
Dim objGroup, objMember

Set objWsNet = CreateObject("WScript.Network")
strDomain = objWsNet.UserDomain
Set objWsNet = Nothing
If Len(strAdmins) > 0 Then
    blnModify = True
    strAdmins = Replace(strAdmins, "Domain", strDomain, 1, -1, vbTextCompare)
Else
    blnModify = False
End If
On Error Resume Next
With objBook.Worksheets(1)
    For i = 2 To .Range("a1").CurrentRegion.Rows.Count
        strListFull = vbNullString: strListRemoved = vbNullString: strListNotRemoved = vbNullString
        strListAdded = vbNullString: strListNotAdded = vbNullString
        .Cells(i, 1).Activate
        strTemp = .Cells(i, 1).Value
        .Range("c" & i & ":f" & i).ClearContents
        If Available(strTemp) Then
            Set objGroup = GetObject("WinNT://" & strDomain & "/" & strTemp & "/Администраторы,group")
            If Err.Number <> 0 Then
                Err.Clear
                Set objGroup = GetObject("WinNT://" & strDomain & "/" & strTemp & "/Administrators,group")
                If Err.Number <> 0 Then
                    Err.Clear
                End If
            End If
            If Not objGroup Is Nothing Then
                If blnModify Then strAdmins2 = Replace(strAdmins, "Local", strDomain & "/" & strTemp, 1, -1, vbTextCompare)
                For Each objMember In objGroup.Members
                    strTemp = Mid(objMember.ADsPath, 9) & ";"
                    strListFull = strListFull & strTemp
                    If blnModify Then
                        If InStr(1, strAdmins2, strTemp, vbTextCompare) = 0 Then
                            intRes = objGroup.Remove(objMember.ADsPath)
                            If intRes = 0 Then
                                strListRemoved = strListRemoved & strTemp
                            Else
                                strListNotRemoved = strListNotRemoved  & strTemp
                            End If
                        End If
                    End If                
                Next
                .Cells(i, 2).Value = Left(strListFull, Len(strListFull) - 1)
                If blnModify Then
                    arrTemp = Split(Left(strAdmins2, Len(strAdmins2) - 1), ";")
                    For j = 0 To UBound(arrTemp)
                        If InStr(1, strListFull, arrTemp(j), vbtextCompare) = 0 Then
                            Set objTemp = GetObject("WinNT://" & arrTemp(j))
                            If Err.Number = 0 Then
                                intRes = objGroup.Add("WinNT://" & arrTemp(j))
                                If intRes = 0 Then
                                    strListAdded = strListAdded & arrTemp(j) &";"
                                Else
                                    strListNotAdded = strListNotAdded & arrTemp(j) & ";"
                                End If
                                Set objTemp = Nothing
                            Else
                                strListNotAdded = strListNotAdded & arrTemp(j) & " (не найден);"
                                Err.Clear
                            End If
                        End If
                    Next
                    .Cells(i, 3).Value = Left(strListRemoved, Len(strListRemoved) - 1)
                    .Cells(i, 4).Value = Left(strListNotRemoved, Len(strListNotRemoved) - 1)
                    .Cells(i, 5).Value = Left(strListAdded, Len(strListAdded) - 1)
                    .Cells(i, 6).Value = Left(strListNotAdded, Len(strListNotAdded) - 1)
                End If
            Else
                .Cells(i, 2).Value = "Ошибка подключения"
            End If
        Else
            .Cells(i, 2).Value = "Не отвечает или не существует"
        End If
        Set objMember = Nothing
        Set objGroup = Nothing
    Next
    .Columns("b:f").AutoFit
End With
End Function

'======

Function Available(strName)
Dim objWMI, objItem

Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address='" & strName & "'")
For Each objItem In objWMI
    If IsNull(objItem.StatusCode) Or objItem.StatusCode <> 0 Then
        Available = False
    Else
        Available = True
    End If
Next
Set objItem = Nothing
Set objWMI = Nothing
End Function

Dim objShell, strBaseFolder
Dim objDialog, intRes, strBookComputers, strAdminsList
Dim objExcel, objWB

Set objShell = CreateObject("Shell.Application")
strBaseFolder = objShell.NameSpace(&H5).Self.Path
Set objShell = Nothing
MsgBox "Укажите файл книги EXCEL со списком проверяемых компьютеров.", vbQuestion, "Контроль группы локальных администраторов"
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Книга MS Excel 97-2003 (*.xls)|*.xls|Книга MS Excel 2007 (*.xlsx)|*.xlsx"
objDialog.FilterIndex = 1
objDialog.InitialDir = strBaseFolder
intRes = objDialog.ShowOpen
If intRes <> 0 Then
    strBookComputers = objDialog.FileName
    Set objExcel = CreateObject("Excel.Application")
    strAdminsList = vbNullString
    intRes = 0
    MsgBox "Укажите файл книги EXCEL с допустимым списком локальных администраторов.", vbQuestion, "Контроль группы локальных администраторов"
    Set objDialog = CreateObject("UserAccounts.CommonDialog")
    objDialog.Filter = "Книга MS Excel 97-2003 (*.xls)|*.xls|Книга MS Excel 2007 (*.xlsx)|*.xlsx"
    objDialog.FilterIndex = 1
    objDialog.InitialDir = strBaseFolder
    intRes = objDialog.ShowOpen
    If intRes <> 0 Then
        strTemp = objDialog.FileName
        Set objWB = objExcel.Workbooks.Open(strTemp)
        For i = 2 To objWB.Worksheets(1).Range("a1").CurrentRegion.Rows.Count
            strAdminsList = strAdminsList & objWB.Worksheets(1).Cells(i, 1).Value & ";"
        Next
        objWB.Close
    Else
        MsgBox "Файл книги EXCEL с допустимым списком локальных администраторов не выбран." & vbNewLine & _
                "Очистка списка от недопустимых записей выполняться не будет.", vbExclamation, "Контроль группы локальных администраторов"
    End If
    Set objWB = objExcel.Workbooks.Open(strBookComputers)
    objExcel.Visible = True
    Call LocalAdmins_Auditor(objWB, strAdminsList)
    objWB.Save
    objWB.Close
    objExcel.Quit
    Set objWB = Nothing
    Set objExcel = Nothing
    MsgBox "Готово.", vbInformation, "Контроль группы локальных администраторов"
Else
    MsgBox "Файл книги EXCEL со списком проверяемых компьютеров не выбран.", vbCritical, "Контроль группы локальных администраторов"
End If
Set objDialog = Nothing
Wscript.Quit 0

'======

Function LocalAdmins_Auditor(objBook, strAdmins)
Dim objWsNet, strDomain, strTemp, blnClear
Dim strAdmins2, strListFull, strListRemoved, strListNotRemoved
Dim objGroup, objMember, intRes

Set objWsNet = CreateObject("WScript.Network")
strDomain = objWsNet.UserDomain
Set objWsNet = Nothing
If Len(strAdmins) > 0 Then
    'MsgBox "Вызвано для просмотра и очистки."
    blnClear = True
    strAdmins = Replace(strAdmins, "Domain", strDomain, 1, -1, vbTextCompare)
Else
    'MsgBox "Вызвано только для просмотра."
    blnClear = False
End If
On Error Resume Next
With objBook.Worksheets(1)
    For i = 2 To .Range("a1").CurrentRegion.Rows.Count
        strListFull = vbNullString: strListRemoved = vbNullString: strListNotRemoved = vbNullString
        .Cells(i, 1).Activate
        strTemp = .Cells(i, 1).Value
        Set objGroup = GetObject("WinNT://" & strDomain & "/" & strTemp & "/Администраторы,group")
        If Err.Number <> 0 Then
            Err.Clear
            Set objGroup = GetObject("WinNT://" & strDomain & "/" & strTemp & "/Administrators,group")
            If Err.Number <> 0 Then
                Err.Clear
            End If
        End If
        If Not objGroup Is Nothing Then
            If blnClear Then strAdmins2 = Replace(strAdmins, "Local", strDomain & "/" & strTemp, 1, -1, vbTextCompare)
            For Each objMember In objGroup.Members
                strTemp = Mid(objMember.ADsPath, 9) & ";"
                strListFull = strListFull & strTemp
                If blnClear Then
                    If InStr(1, strAdmins2, strTemp, vbTextCompare) = 0 Then
                        intRes = objGroup.Remove(objMember.ADsPath)
                        If intRes = 0 Then
                            strListRemoved = strListRemoved & strTemp
                        Else
                            strListNotRemoved = strListNotRemoved  & strTemp
                        End If
                    End If
                End If                
            Next
            .Cells(i, 2).Value = Left(strListFull, Len(strListFull) - 1)
            If blnClear Then
                .Cells(i, 3).Value = Left(strListRemoved, Len(strListRemoved) - 1)
                .Cells(i, 4).Value = Left(strListNotRemoved, Len(strListNotRemoved) - 1)
            End If
        Else
            .Cells(i, 2).Value = "Ошибка подключения"
            .Range("c" & i & ":d" & i).ClearContents
        End If
        Set objMember = Nothing
        Set objGroup = Nothing
        .Columns("b:d").AutoFit
    Next
End With
End Function