Add and Remove from collection using Excel VBA

This is crude and unfinished but I wanted to post it ASAP so I don’t lose it.

 

[Excel VBA code]
Option Explicit
Sub ConnectWMIServer()
' version 1.1.0.0
' Author Roger 7/19/2017

    Const wbemFlagReturnImmediately = &H10
    Const wbemFlagForwardOnly = &H20
    Dim objWMIService, StrQuery, ColItems, objItem
    Dim objSmsNewRule, objSMS_Collection
    Dim ComputerName: ComputerName = "XX6761"
    Dim CollectionID: CollectionID = "XXX00226"
    Dim ColResourceID, ResourceID
    Dim CurrentRow: CurrentRow = 1
    Dim ReturnValue
        
    Sheets("WMI_Results").Range("A" & CurrentRow).Value = "Processing"
    On Error Resume Next
    Set objWMIService = GetObject("winmgmts:{impersonationlevel=impersonate}!\\orsccm02\ROOT\SMS\site_OR2")
    On Error GoTo 0
    
    ' connect to the SCCM server through WMI
    If Not IsObject(objWMIService) Then
        Sheets("WMI_Results").Range("A" & CurrentRow).Value = "Error: Failed to connect to WMI:\\orsccm02\ROOT\SMS\site_OR2:SMS_Collection"
        End
    Else
        Sheets("WMI_Results").Range("A" & CurrentRow).Value = "Success: Connected to WMI:\\XXXccm02\ROOT\SMS\site_XXX:SMS_Collection"
    End If
    CurrentRow = CurrentRow + 1

    ' read the ResourceID for the given ComputerName
    StrQuery = "Select ResourceID From SMS_R_System Where Name ='" & ComputerName & "'"
    Sheets("WMI_Results").Range("A" & CurrentRow).Value = "Processing"
    On Error Resume Next
    Set ColResourceID = objWMIService.ExecQuery(StrQuery, "WQL", wbemFlagForwardOnly)
    On Error GoTo 0
    If Not IsObject(ColResourceID) Then
        Sheets("WMI_Results").Range("A" & CurrentRow).Value = "Error: Failed to execute query [" & StrQuery & "]"
    Else
        Sheets("WMI_Results").Range("A" & CurrentRow).Value = "Success: executed query [" & StrQuery & "]"
        For Each objItem In ColResourceID
            Sheets("WMI_Results").Range("B" & CurrentRow).Value = objItem.ResourceID
            ResourceID = objItem.ResourceID
        Next
    End If
   
    ' instantiate and populate a new direct rule object
    Set objSmsNewRule = GetObject("winmgmts:{impersonationlevel=impersonate}!\\sccm02\ROOT\SMS\site_XXX:SMS_CollectionRuleDirect")
    objSmsNewRule.RuleName = ComputerName
    objSmsNewRule.ResourceID = ResourceID
    objSmsNewRule.ResourceClassName = "SMS_R_System"
    
    CurrentRow = CurrentRow + 1
    
    ' read data about the collection
    StrQuery = "SELECT * FROM SMS_Collection WHERE CollectionID='" & CollectionID & "'"
    Sheets("WMI_Results").Range("A" & CurrentRow).Value = "Processing"
    On Error Resume Next
    Set ColItems = objWMIService.ExecQuery(StrQuery, "WQL", wbemFlagForwardOnly)
    On Error GoTo 0
       
    If Not IsObject(ColItems) Then
        Sheets("WMI_Results").Range("A" & CurrentRow).Value = "Error: Failed to execute query [" & StrQuery & "]"
    Else
        Sheets("WMI_Results").Range("A" & CurrentRow).Value = "Success: executed query [" & StrQuery & "]"
        For Each objItem In ColItems
            'Sheets("WMI_Results").Range("A" & CurrentRow).Value = objItem.CollectionID
            Sheets("WMI_Results").Range("B" & CurrentRow).Value = objItem.Name
        Next
    End If
    
    ' (testing) read the rules for a collection
    CurrentRow = CurrentRow + 1
    Sheets("WMI_Results").Range("A" & CurrentRow).Value = "Processing"
    On Error Resume Next
    ' ================================================================================
    StrQuery = "Select * from SMS_Collection WHERE CollectionID='" & CollectionID & "'"
    Set objSMS_Collection = objWMIService.ExecQuery(StrQuery, "WQL", wbemFlagForwardOnly)
    ' ================================================================================
    On Error GoTo 0
    
    Dim objThisCollection, i, x
    
    If Not IsObject(objSMS_Collection) Then
        Sheets("WMI_Results").Range("A" & CurrentRow).Value = "Error: Failed to execute query [" & StrQuery & "]"
    Else
        Sheets("WMI_Results").Range("A" & CurrentRow).Value = "Success.  Typename is "
        Sheets("WMI_Results").Range("B" & CurrentRow).Value = TypeName(objSMS_Collection)
        'Sheets("WMI_Results").Range("c" & CurrentRow).Value = objSMS_Collection.Count
        For Each objItem In objSMS_Collection
            CurrentRow = CurrentRow + 1: Sheets("WMI_Results").Range("A" & CurrentRow).Value = "TypeName(objItem.CollectionRules)"
            Sheets("WMI_Results").Range("A" & CurrentRow).Value = "Processing"
                       
            On Error Resume Next 'get the lazy values
            Set objThisCollection = objWMIService.Get("SMS_Collection.CollectionID='" + CollectionID + "'")
            On Error GoTo 0
            
            If Not IsObject(objThisCollection) Then
                Sheets("WMI_Results").Range("A" & CurrentRow).Value = "FAILED"
            Else
                Sheets("WMI_Results").Range("A" & CurrentRow).Value = "SUCCESS"
                ' Display the rule names that are in the lazy property CollectionRules.
                If IsNull(objThisCollection.CollectionRules) Then
                    Sheets("WMI_Results").Range("B" & CurrentRow).Value = "No rules"
                Else
                    For i = 0 To UBound(objThisCollection.CollectionRules)
                        Sheets("WMI_Results").Range("a" & CurrentRow).Value = "Rule Name: " + objThisCollection.CollectionRules(i).RuleName _
                                                                            + " (" + TypeName(objThisCollection.CollectionRules(i)) + ")"
                        Select Case TypeOfRule(objThisCollection.CollectionRules(i)) ' print details of different types of rules
                            Case "SMS_CollectionRuleDirect"  ' DIRECT ENTRY RULE
                                Sheets("WMI_Results").Range("B" & CurrentRow).Value = "ResourceClassName: " + objThisCollection.CollectionRules(i).ResourceClassName
                                Sheets("WMI_Results").Range("C" & CurrentRow).Value = "ResourceID: " + CStr(objThisCollection.CollectionRules(i).ResourceID)
                                ' REMOVE ANY DIRECT ENTRY RULES
                                ReturnValue = objThisCollection.DeleteMembershipRule(objThisCollection.CollectionRules(i))
                                CurrentRow = CurrentRow + 1: Sheets("WMI_Results").Range("A" & CurrentRow).Value = "DeleteDirect ReturnValue"
                                Sheets("WMI_Results").Range("B" & CurrentRow).Value = ReturnValue
                                
                            Case "SMS_CollectionRuleIncludeCollection" ' INCLUDE COLLECTION RULE
                                Sheets("WMI_Results").Range("B" & CurrentRow).Value = "IncludeCollectionID: " + objThisCollection.CollectionRules(i).IncludeCollectionID
                                'Sheets("WMI_Results").Range("B" & CurrentRow).Interior.Color = RGB(200, 200, 200) ' set the color
                                'Sheets("WMI_Results").Range("B" & CurrentRow).Font.Color = RGB(200, 0, 0) ' set the color
                                ' REMOVE ANY INCLUDE COLLECTION RULES
                                ReturnValue = objThisCollection.DeleteMembershipRule(objThisCollection.CollectionRules(i))
                                CurrentRow = CurrentRow + 1: Sheets("WMI_Results").Range("A" & CurrentRow).Value = "DeleteInclude ReturnValue"
                                Sheets("WMI_Results").Range("B" & CurrentRow).Value = ReturnValue
                                
                            Case "SMS_CollectionRuleExcludeCollection" ' EXCLUDE COLLECTION RULE
                                Sheets("WMI_Results").Range("B" & CurrentRow).Value = "ExcludeCollectionID: " + objThisCollection.CollectionRules(i).ExcludeCollectionID
                                'Sheets("WMI_Results").Range("B" & CurrentRow).Interior.Color = RGB(255, 255, 255) ' set the color
                                'Sheets("WMI_Results").Range("B" & CurrentRow).Font.Color = RGB(200, 200, 50) ' set the color
                                
                            Case "SMS_CollectionRuleQuery" ' QUERY RULE
                                Sheets("WMI_Results").Range("B" & CurrentRow).Value = "QueryID: " + CStr(objThisCollection.CollectionRules(i).QueryID)
                                Sheets("WMI_Results").Range("C" & CurrentRow).Value = objThisCollection.CollectionRules(i).QueryExpression
                                'Sheets("WMI_Results").Range("B" & CurrentRow).Interior.Color = RGB(200, 200, 200) ' set the color
                                'Sheets("WMI_Results").Range("B" & CurrentRow).Font.Color = RGB(200, 0, 0) ' set the color
                                ' REMOVE ANY QUERY RULES
                                ReturnValue = objThisCollection.DeleteMembershipRule(objThisCollection.CollectionRules(i))
                                CurrentRow = CurrentRow + 1: Sheets("WMI_Results").Range("A" & CurrentRow).Value = "DeleteQuery ReturnValue"
                                Sheets("WMI_Results").Range("B" & CurrentRow).Value = ReturnValue
                        End Select
                        CurrentRow = CurrentRow + 1
                    Next
                    Set objThisCollection = objWMIService.Get("SMS_Collection.CollectionID='" + CollectionID + "'")
                End If
            End If
            Sheets("WMI_Results").Range("A" & CurrentRow).Value = "'============================="
            
            'test: add a direct member
            '===[ Add a rule to the collection ===
            ReturnValue = objThisCollection.AddMembershipRule(objSmsNewRule)
            CurrentRow = CurrentRow + 1: Sheets("WMI_Results").Range("A" & CurrentRow).Value = "AddRule ReturnValue"
            Sheets("WMI_Results").Range("B" & CurrentRow).Value = ReturnValue
        Next
    End If
    
'===========================================
End '===========================================
'===========================================
   
    'PSEUDOCODE FOR UPDATING THE MEMBERSHIP
    ' GIVEN: "ThisCollection" ID of collection to modify
    ' GIVEN: "ComputerIDs" ID(s) of Computers to add as direct members
    ' Maybe GIVEN: "ExcludeCollections" ID(s) of collection(s) to exclude - this should be whatever's already excluded
    ' With SMS_Collection
        ' Maybe VerifyNoCircularDependencies (compare ThisCollection against ExcludeCollections)
        ' delete all direct rules (Delete all rules by saving a zero-element array)
        ' add new direct rules fo the computerIDs
        
End Sub

Function TypeOfRule(ojbThisRule) ' returns the type of rule, because I can't find a way to ask the system what the class is
Dim x
    TypeOfRule = "Unknown"
    x = "Test": On Error Resume Next: x = ojbThisRule.ResourceID: On Error GoTo 0
    If Not x = "Test" Then TypeOfRule = "SMS_CollectionRuleDirect"
    x = "Test": On Error Resume Next: x = ojbThisRule.IncludeCollectionID: On Error GoTo 0
    If Not x = "Test" Then TypeOfRule = "SMS_CollectionRuleIncludeCollection"
    x = "Test": On Error Resume Next: x = ojbThisRule.ExcludeCollectionID: On Error GoTo 0
    If Not x = "Test" Then TypeOfRule = "SMS_CollectionRuleExcludeCollection"
    x = "Test": On Error Resume Next: x = ojbThisRule.QueryID: On Error GoTo 0
    If Not x = "Test" Then TypeOfRule = "SMS_CollectionRuleQuery"
End Function




Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s