vbScript - set permissons on ConfigMgr Objects in bulk

This little vbscript loops throught the file SetPermissons.txt and creates all class and instance permissons for your ConfigMgr Objects which are defined

File Structure must be:
1st postition: Object Level (Possible Values: Class(C) or Instance (I))
2nd postition: Object Type (COLLECTION, ADVERTISEMENT, PACKAGE, ...)
3rd postition: Object Name (If Object Level is Class, the Name is not used. Best value in this case is "N/A")
4th postition: Username (Format: domain\username)
5th postition: Permissons (Format: Permisson1&Permisson2&...) - For all Permissons on an Object use keyword "FULL". Check the lower part of the vbScript for detailed information. Also note that the permissons have to make sense. So please first check the available permissons for each object in your ConfigMgr Console

# are and blank lines are ignored
# are available for comments

The SetPermissons.txt file should look like this:

###########################################################################
############################### EXAMPLES ##################################
###########################################################################
### I;COLLECTION;All Systems;mydomain\myuser;READ&MODIFY&READ_RESOURCE
### I;COLLECTION;All Systems;mydomain\myuser2;READ&ADVERTISE&DELETE_RESOURCE
### I;PACKAGE;Adobe_Reader;mydomain\myuser2;DISTRIBUTE
### I;PACKAGE;Adobe_Reader;mydomain\myuser;MODIFY&DISTRIBUTE
### I;ADVERTISEMENT;Install_Adobe_Reader;mydomain\myuse;FULL
### C;SITE;N/A;mydomain\myuser;FULL
### C;TASKSEQUENCE;N/A;mydomain\myuser2;READ&MODIFY
###########################################################################
###########################################################################
###########################################################################

#Set Collections Permissons
I;Collection;MyCollectionABC;mydomain\BillGates;READ&MODIFY&READ_RESOURCE
I;Collection;MyCollectionXYZ;mydomain\SteveBallmer;READ&ADVERTISE&DELETE_RESOURCE

#Set Package Permissons
I;PACKAGE;Adobe_Reader;mydomain\BillGates;DISTRIBUTE
I;PACKAGE;Adobe_Reader;mydomain\SteveBallmer;READ&DISTRIBUTE
I;PACKAGE;Adobe_Reader;mydomain\ElvisPresley;READ&MODIFY&DISTRIBUTE

#Set Advertisement Permissons
I;Advertisement;Repair_Java;mydomain\SteveBallmer;READ

#Set Permissons for the new HelpDesk Employee
I;COLLECTION;MyCollection;mydomain\johnwayne;READ
I;COLLECTION;HisCollection;mydomain\johnwayne;READ&MODFIY
I;Advertisement;Uninstall_7ZIP;mydomain\johnwayne;READ&DELETE
C;COLLECTION;N/A;mydomain\johnwayne;READ
C;SITE;N/A;mydomain\johnwayne;READ&IMPORTMACHINE

#Set Permissons for the Group OSD Admins
C;OSINSTALLPACKAGE;N/A;mydomain\OSDAdmins;FULL
C;COMPUTERASSOCIATION;N/A;mydomain\OSDAdmins;READ&DELETE&ADMINISTER&CREATE
C;OSIMAGE;N/A;mydomain\OSDAdmins;FULL
C;TASKSEQUENCE;N/A;mydomain\OSDAdmins;FULL
C;DRIVERPACKAGE;N/A;mydomain\OSDAdmins;FULL
C;DEVICEDRIVER;N/A;mydomain\OSDAdmins;FULL

The vbScript is the below code - Have fun ;)
Note: There's not build in a lot of error handling, so please first test it carefully

'************************************************************************************************************
' Jonas Hettich
'************************************************************************************************************
'
' Ver 1.00 - 13.04.2011 - initial version
'
' What this script does:
' This Scripts creates the Permissons defined in the file SetPermissons.txt
'
' Not Supported: Instace Rights for Drivers, Asset Intelligence
'************************************************************************************************************

result = MsgBox("Do you really want to create the Collection Permissons?", vbYesNo)
If result = vbNo Then WScript.Quit

Dim strChoosenPermissons
Dim strSiteServer : strSiteServer = ""
Dim strSitecode : strSitecode = ""
Dim objSWbemLocator : Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
Dim objSWbemServices : Set objSWbemServices = objSWbemLocator.ConnectServer(strSiteServer,"root/sms/site_" & strSitecode)

Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objFile : Set objFile = objFSO.OpenTextFile("SetPermissons.txt")
Dim strCurrentLine
Dim strObjectsType, strObjectName, strUser, strPermissons, strObjectEnv

'Loop the Source File
Do While not objFile.AtEndOfStream
 strCurrentLine = objFile.ReadLine
 
 'Skip Comment and Blank lines
 If strCurrentLine <> "" Then
  If Not Left(strCurrentLine,1) = "#" Then
   
   'Parse the information
   strObjectEnv = Ucase(Split(strCurrentLine,";")(0))
   strObjectsType = Ucase(Split(strCurrentLine,";")(1))
   strObjectName = Ucase(Split(strCurrentLine,";")(2))
   strUser = Ucase(Split(strCurrentLine,";")(3))
   strPermissons = Ucase(Split(strCurrentLine,";")(4))
   
   Call SetInstanceRights(strObjectEnv,strObjectsType, strObjectName, strUser, strPermissons)

   'Reset the Permissons for the next action
   strChoosenPermissons = 0
   
  End If
 End If
 

Loop

Function NameToID(strObjectType,strObjectName)
Dim colResuls, objResult

Select Case (strObjectType)
Case("COLLECTION")

 Set colResults = objSWbemServices.ExecQuery ("select * from SMS_Collection where Name='" & strObjectName & "'")
 For Each objResult In colResults
  NameToID = objResult.CollectionID
 Next

Case("PACKAGE")

 Set colResults = objSWbemServices.ExecQuery ("select * from SMS_Package where Name='" & strObjectName & "'")
 For Each objResult In colResults
  NameToID = objResult.PackageID
 Next
 
Case ("ADVERTISEMENT")

 Set colResults = objSWbemServices.ExecQuery ("select * from SMS_Advertisement where AdvertisementName='" & strObjectName & "'")
 For Each objResult In colResults
  NameToID = objResult.AdvertisementID
 Next
 
Case ("TASKSEQUENCE")

 Set colResults = objSWbemServices.ExecQuery ("Select * from SMS_TaskSequencePackage where Name='" & strObjectName & "'")
 For Each objResult In colResults
  NameToID = objResult.PackageID
 Next
 
Case ("OSINSTALLPACKAGE")

 Set colResults = objSWbemServices.ExecQuery ("Select * from SMS_OperatingSystemInstallPackage where Name='" & strObjectName & "'")
 For Each objResult In colResults
  NameToID = objResult.PackageID
 Next

Case ("OSIMAGE")

 Set colResults = objSWbemServices.ExecQuery ("Select * from SMS_ImagePackage where Name='" & strObjectName & "'")
 For Each objResult In colResults
  NameToID = objResult.PackageID
 Next 

Case ("BOOTIMAGE")

 Set colResults = objSWbemServices.ExecQuery ("Select * from SMS_BootImagePackage where Name='" & strObjectName & "'")
 For Each objResult In colResults
  NameToID = objResult.PackageID
 Next  

Case ("DRIVERPACKAGE")

 Set colResults = objSWbemServices.ExecQuery ("Select * from SMS_DriverPackage where Name='" & strObjectName & "'")
 For Each objResult In colResults
  NameToID = objResult.PackageID
 Next
Case Else
 Log "Error: Objecttype not supported"
 Exit Function
End Select

End Function

Function SetInstanceRights(ObjectEnv, ObjectType, ObjectName, User, Permissons)
 Dim arrPermissons, strPermisson
 Dim strObjectID
 Dim objUserPermissions
 
 'Choose between Class and Instance Permissons
 If ObjectEnv = "I" Then
  Set objUserPermissions = objSWbemServices.Get("SMS_UserInstancePermissions")
  Log vbNewLine &"*** Configure Instance Permissons ***"
 ElseIf ObjectEnv = "C" Then
  Set objUserPermissions = objSWbemServices.Get("SMS_UserClassPermissions")
  Log vbNewLine &"*** Configure Class Permissons ***"
 Else
  Log "Error: Object Environment not available. Must be Class(C) or Instance(I)"
  WScript.Quit
 End If
 
 
 'Create UserInstancePermissonsObject
 Set objNewUserPermissions = objUserPermissions.SpawnInstance_
 
 'Set the Objecttype
 Select Case (ObjectType)
 Case "COLLECTION"
  objNewUserPermissions.ObjectKey = 1
 Case "PACKAGE"
  objNewUserPermissions.ObjectKey = 2
 Case "ADVERTISEMENT"
  objNewUserPermissions.ObjectKey = 3
 Case "STATUSMESSAGE"
  objNewUserPermissions.ObjectKey = 4
 Case "SITE"
  objNewUserPermissions.ObjectKey = 6
 Case "QUERY"
  objNewUserPermissions.ObjectKey = 7
 Case "REPORT"
  objNewUserPermissions.ObjectKey = 8
 Case "SOFTWAREMETERINGRULE"
  objNewUserPermissions.ObjectKey = 9
 Case "APPLICABLEUPDATESSUMMARY"
  objNewUserPermissions.ObjectKey = 10
 Case "CONFIGURATIONITEMS"
  objNewUserPermissions.ObjectKey = 11
 Case "OSINSTALLPACKAGE"
  objNewUserPermissions.ObjectKey = 14
 Case "DEPLOYMENTTEMPLATE"
  objNewUserPermissions.ObjectKey = 15
 Case "DEPLOYMENT"
  objNewUserPermissions.ObjectKey = 16
 Case "COMPUTERASSOCIATION"
  objNewUserPermissions.ObjectKey = 17
 Case "OSIMAGE"
  objNewUserPermissions.ObjectKey = 18
 Case "BOOTIMAGE"
  objNewUserPermissions.ObjectKey = 19
 Case "TASKSEQUENCE"
  objNewUserPermissions.ObjectKey = 20
 Case "DEVICESETTINGPACKAGE"
  objNewUserPermissions.ObjectKey = 21
 Case "DEVICESETTINGITEM"
  objNewUserPermissions.ObjectKey = 22
 Case "DRIVERPACKAGE"
  objNewUserPermissions.ObjectKey = 23
 Case "DEPLYOMENTPACKAGE"
  objNewUserPermissions.ObjectKey = 24
 Case "DEVICEDRIVER"
  objNewUserPermissions.ObjectKey = 25
 Case Else
  Log "Error: Objecttype not supported"
  Exit Function
 End Select 
 
 
 'Set the Object ID
 If ObjectEnv = "I" Then
  strObjectID = NameToID(ObjectType,ObjectName)
  If strObjectID <> "" Then 
   objNewUserPermissions.InstanceKey = strObjectID
  Else
   Log "Error: " &ObjectType &" was not found: " &ObjectName
   WScript.Quit
  End If
 End If
 
 'Set the User or Group
 objNewUserPermissions.UserName = User
 
 'Set the Permissons
 If Permissons = "FULL" Then
  'Set Full Permissons String
  Permissons = FullPermissons(ObjectType,ObjectEnv)
 End If

 
 arrPermissons = Split(Permissons,"&")
 For Each strPermisson In arrPermissons
  
  'Parse the Permissons
  'http://msdn.microsoft.com/en-us/library/cc143194.aspx
  Select Case UCASE(strPermisson)
  Case "READ"
   strChoosenPermissons = strChoosenPermissons + 1
  Case "MODIFY"
   strChoosenPermissons = strChoosenPermissons + 2
  Case "DELETE"
   strChoosenPermissons = strChoosenPermissons + 4
  Case "DISTRIBUTE"
   strChoosenPermissons = strChoosenPermissons + 8
  Case "REMOTE_CONTROL"
   strChoosenPermissons = strChoosenPermissons + 32
  Case "ADVERTISE"
   strChoosenPermissons = strChoosenPermissons + 64
  Case "MODIFY_RESOURCE"
   strChoosenPermissons = strChoosenPermissons + 128
  Case "ADMINISTER"
   strChoosenPermissons = strChoosenPermissons + 256
  Case "DELETE_RESOURCE"
   strChoosenPermissons = strChoosenPermissons + 512
  Case "CREATE"
   If ObjectEnv = "I" And ObjectType = "COLLECTION" Then
    'Collection Instances do no have the permissons CREATE, ADMINISTER, DELEGATE
    Log "ERROR: CREATE, ADMINISTER and DELEGATE permissons are not possible on Collection Instances"
    Exit Function
   Else
    strChoosenPermissons = strChoosenPermissons + 1024
   End If
  Case "VIEWCOLLECTEDFILES"
   strChoosenPermissons = strChoosenPermissons + 2048
  Case "READ_RESOURCE"
   strChoosenPermissons = strChoosenPermissons + 4096
  Case "DELEGATE"
   strChoosenPermissons = strChoosenPermissons + 8192
  Case "METER"
   strChoosenPermissons = strChoosenPermissons + 16384
  Case "MANAGESQLCOMMAND"
   strChoosenPermissons = strChoosenPermissons + 32768
  Case "MANAGESTATUSFILTER"
   strChoosenPermissons = strChoosenPermissons + 65536
  Case "MANAGEFOLDERS"
   strChoosenPermissons = strChoosenPermissons + 131072
  Case "NETWORKACCESS"
   strChoosenPermissons = strChoosenPermissons + 262144
  Case "IMPORTMACHINE"
   strChoosenPermissons = strChoosenPermissons + 524288
  Case "CREATETASKSEQUENCEMEDIA"
   strChoosenPermissons = strChoosenPermissons + 1048576
  Case "MODIFYCOLLECTIONSETTING"
   strChoosenPermissons = strChoosenPermissons + 2097152
  Case "MANAGEOSDCERTIFICATE"
   strChoosenPermissons = strChoosenPermissons + 4194304
  Case "RECOVERUSERSTATE"
   strChoosenPermissons = strChoosenPermissons + 8388608
  Case "MANAGEMGMTCONROLLERS"
   strChoosenPermissons = strChoosenPermissons + 16777216
  Case "VIEWMGMTCONROLLERS"
   strChoosenPermissons = strChoosenPermissons + 33554432
  Case Else
   Log "Error: Permissons not supported"
  End Select 
    
 Next


 If ObjectEnv = "I" Then
  objNewUserPermissions.InstancePermissions = strChoosenPermissons
 ElseIf ObjectEnv = "C" Then
  objNewUserPermissions.ClassPermissions  = strChoosenPermissons
 End If

 
 'Creating Permissons
 On Error Resume Next
 objNewUserPermissions.put_
 
 
 If Err.Number = 0 Then
  Log "Successfully set following permissons:"
  Log vbTab &" - ObjectType: " &ObjectType
  Log vbTab &" - ObjectName: " &ObjectName
  Log vbTab &" - User: " &User
  Log vbTab &" - Permissons: " &Permissons 
 Else
  Log "Error (" &Err.Description  &") when trying to create the object:"
  Log vbTab &" - ObjectType: " &ObjectType
  Log vbTab &" - ObjectName: " &ObjectName
  Log vbTab &" - User: " &User
  Log vbTab &" - Permissons: " &Permissons 
 End If

 
 Set objNewUserPermissions = Nothing
  
End Function


Function FullPermissons(ObjectType,ObjectEnv)

Select Case (ObjectType)

Case "SITE"
 FullPermissons = "IMPORTMACHINE&DELEGATE&ADMINISTER&CREATE&DELETE&READ&MODIFY&MANAGEOSDCERTIFICATE&MANAGESTATUSFILTER&MANAGESQLCOMMAND&METER"
Case "OSINSTALLPACKAGE"
 FullPermissons = "READ&DISTRIBUTE&MODIFY&DELETE&ADMINISTER&CREATE&MANAGEFOLDERS&DELEGATE"
Case "OSIMAGE"
 FullPermissons = "READ&DISTRIBUTE&MODIFY&DELETE&ADMINISTER&CREATE&MANAGEFOLDERS&DELEGATE"
Case "TASKSEQUENCE"
 FullPermissons = "READ&CREATETASKSEQUENCEMEDIA&MODIFY&DELETE&ADMINISTER&CREATE&MANAGEFOLDERS&DELEGATE"
Case "DRIVERPACKAGE"
 FullPermissons = "READ&DISTRIBUTE&MODIFY&DELETE&ADMINISTER&CREATE&MANAGEFOLDERS&DELEGATE"
Case "STATUSMESSAGE" 
 FullPermissons = "READ&DELETE&CREATE&ADMINISTER"
Case "QUERY"
 FullPermissons ="READ&MODIFY&DELETE&ADMINISTER&CREATE&DELEGATE&MANAGEFOLDERS"
Case "REPORT"
 FullPermissons = "READ&MODIFY&DELETE&ADMINISTER&CREATE&DELEGATE&MANAGEFOLDERS"
Case "SOFTWAREMETERINGRULE"
 FullPermissons = "READ&MODIFY&DELETE&ADMINISTER&CREATE&DELEGATE&MANAGEFOLDERS"
Case "APPLICABLEUPDATESSUMMARY"
 FullPermissons = "READ&MODIFY&DELETE&ADMINISTER&CREATE&DELEGATE"
Case "CONFIGURATIONITEMS"
 FullPermissons = "READ&MODIFY&DELETE&DISTRIBUTE&ADMINISTER&CREATE&DELEGATE&MANAGEFOLDERS&NETWORKACCESS"
Case "DEPLOYMENTTEMPLATE"
 FullPermissons = "READ&MODIFY&DELETE&ADMINISTER&CREATE&DELEGATE"
Case "DEPLOYMENT"
 FullPermissons = "READ&MODIFY&DELETE&ADMINISTER&CREATE&DELEGATE"
Case "DEVICESETTINGPACKAGE"
 FullPermissons ="READ&MODIFY&DELETE&DISTRIBUTE&ADMINISTER&CREATE&DELEGATE&MANAGEFOLDERS"
Case "DEVICESETTINGITEM"
 FullPermissons = "READ&MODIFY&DELETE&ADMINISTER&CREATE&DELEGATE"
Case "DEPLYOMENTPACKAGE"
 FullPermissons = "READ&MODIFY&DELETE&DISTRIBUTE&ADMINISTER&CREATE&DELEGATE&MANAGEFOLDERS"
Case "COLLECTION"
 If ObjectEnv = "C" Then
  FullPermissons = "READ&MODIFY&DELETE&CREATE&REMOTE_CONTROL&ADVERTISE&MODIFY_RESOURCE&ADMINISTER&DELETE_RESOURCE&VIEWCOLLECTEDFILES&READ_RESOURCE&DELEGATE&MODIFYCOLLECTIONSETTING&MANAGEMGMTCONROLLERS&VIEWMGMTCONROLLERS"
 ElseIf ObjectEnv = "I" Then
  'Collection Instances do no have the permissons CREATE, ADMINISTER, DELEGATE
  FullPermissons = "READ&MODIFY&DELETE&REMOTE_CONTROL&ADVERTISE&MODIFY_RESOURCE&DELETE_RESOURCE&VIEWCOLLECTEDFILES&READ_RESOURCE&MODIFYCOLLECTIONSETTING&MANAGEMGMTCONROLLERS&VIEWMGMTCONROLLERS"
 End If
Case "PACKAGE"
 FullPermissons = "READ&MODIFY&DELETE&DISTRIBUTE&ADMINISTER&CREATE&DELEGATE&MANAGEFOLDERS"
Case "ADVERTISEMENT"
 FullPermissons = "READ&MODIFY&DELETE&ADMINISTER&CREATE&DELEGATE&MANAGEFOLDERS"
Case "DRIVERPACKAGE"
 FullPermissons = "READ&MODIFY&DISTRIBUTE&DELETE&ADMINISTER&CREATE&DELEGATE&MANAGEFOLDERS"
Case "COMPUTERASSOCIATION"
 FullPermissons = "READ&DELETE&ADMINISTER&CREATE&DELEGATE&MANAGEFOLDERS&RECOVERUSERSTATE"
Case "DEVICEDRIVER"
 FullPermissons = "READ&MODIFY&DELETE&ADMINISTER&CREATE&DELEGATE&MANAGEFOLDERS"
Case "BOOTIMAGE"
 FullPermissons = "READ&MODIFY&DELETE&DISTRIBUTE&ADMINISTER&CREATE&DELEGATE&MANAGEFOLDERS"
Case Else
 Log "Permissons not supported"
End Select

End Function

Function Log(strTextToLog)
 WScript.Echo strTextToLog
    Dim objFile, objLogFile, objLogFile2
 Dim strFilenameWithoutExtension, intMaxFileSize, n 
        intMaxFileSize = 15 * 1024 * 1024 '15MB 
        'strip ".vbs" from the full path scriptname 
        strFilenameWithoutExtension= left(WScript.ScriptFullName,len(WScript.ScriptFullName)-4) 
    On Error Resume Next 
        n = -1 
        'we need to check the current logfile size 1st - open the current logfile 
        Set objFile = objFSO.getfile(strFilenameWithoutExtension & ".log") 
        'check if the the current logfile is bigger than the max file size 
    If objFile.Size > intMaxFileSize Then 
        'it's bigger - so open the backup log file 
        Set objLogFile2 = objFSO.getfile(strFilenameWithoutExtension & ".lo_") 
        'delete the backup file 
        objLogFile2.Delete 
        'rename the original file to "*.lo_" 
        objFile.name = left(objFile.name, len(objFile.name)-1) & "_" 
                'close the file 
                objFile.close 
    End If 
    Set objLogFile = objFSO.opentextfile(strFilenameWithoutExtension & ".log", 8, True) 
    'objLogFile.writeline Date & " - " & Time & " - """ & strTextToLog & """" 
        objLogFile.writeline Date & " - " & Time & " - " & " - """ & strTextToLog & """" 
  If len(strTextToLog) > 78 then strTextToLog = left(strTextToLog,76) & "..."
        'Log strTextToLog
    objLogFile.Close 
    Set objFile = Nothing 
    Set objFile2 = Nothing 
    Set oLogFile = Nothing 
    Set oFSOLog = Nothing 
    If Err Then Err.Clear 
    On Error GoTo 0 
End Function

vbScript - bulk import collections

This little vbscript loops throught the file CollectionStructure.txt and creates all the defined collections

# are and blank lines are ignored
# are available for comments

The CollectionStructure.txt file should look like this:

############################################
################ EXAMPLES ##################
############################################
### Parent Collection;Child Collection
### COLLROOT;MyCollection1
### Collection1;MyCollection2
############################################
############################################
############################################

#Create Collections for Department XYZ
COLLROOT;Department XYZ
Department XYZ;Department XYZ-123
Department XYZ;Department XYZ-ABC
Department XYZ;Department XYZ-LOL

#Create Collections for Adobe Reader
SWDIST;Adobe Reader
Adobe Reader;Install_Adobe Reader
Adobe Reader;Uninstall_Adobe Reader

The vbScript is the below code - Have fun ;)
Note: There's not build in a lot of error handling, so please first test it

'************************************************************************************************************
' Jonas Hettich
'************************************************************************************************************
' Ver 1.00 - 13.04.2011 - initial version
' What this script does:
' This Scripts creates the Collection Structure defined in the file CollectionStructure.txt
'************************************************************************************************************
result = MsgBox("Do you really want to create the Collections?", vbYesNo)
If result = vbNo Then WScript.Quit

Dim strSiteServer : strSiteServer = ""
Dim strSitecode : strSitecode = ""
Dim objSWbemLocator : Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
Dim objSWbemServices : Set objSWbemServices = objSWbemLocator.ConnectServer(strSiteServer,"root/sms/site_" & strSitecode)

Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objFile : Set objFile = objFSO.OpenTextFile("CollectionStructure.txt")
Dim strCurrentLine
Dim strRootCollection, strChildCollection
Dim strRootCollectionID, strChildCollectionID

'Loop the Source File
Do While not objFile.AtEndOfStream
 strCurrentLine = objFile.ReadLine
 
 'Skip Comment and Blank lines
 If strCurrentLine <> "" Then
  If Not Left(strCurrentLine,1) = "#" Then
   'Parse the Root- and Child Collection
   strRootCollection = Split(strCurrentLine,";")(0)
   strChildCollection = Split(strCurrentLine,";")(1)
   
   'Create the collection.
   Dim strpath
      Dim objChildCollection : Set objChildCollection = objSWbemServices.Get("SMS_Collection").SpawnInstance_()
      objChildCollection.Name = strChildCollection
      objChildCollection.OwnedByThisSite = True
      strpath=objChildCollection.Put_
      
      If Err.Number = 0 Then
       WScript.Echo "Created Collection: " &strChildCollection
      Else
    WScript.Echo "Error creating Collection: " &strChildCollection &" - ErrNumber:" &Err.Number
      End If
      Err.Clear
      
      'Get Collection ID
      Dim objCollection : Set objCollection=objSWbemServices.Get(strpath)
      strChildCollectionID = objCollection.CollectionID
   
   
   'Configure Root Collection
      Dim objCollectionRelation
      Set objCollectionRelation = objSWbemServices.Get( "SMS_CollectToSubCollect" ).SpawnInstance_()
      If strRootCollection = "COLLROOT" Then
       objCollectionRelation.parentCollectionID = strRootCollection
      Else
       objCollectionRelation.parentCollectionID = CollectionNameToID(strRootCollection)
      End If
      objCollectionRelation.subCollectionID = strChildCollectionID
      objCollectionRelation.Put_
      
      If Err.Number = 0 Then
       WScript.Echo "Linked to Root Collection: " &strRootCollection
      Else
    WScript.Echo "Error when linking to Root Collectionn: " &strRootCollection &" - ErrNumber:" &Err.Number
      End If
  End If
 End If
Loop

Function CollectionNameToID(strName)
 Dim strCollection
 Dim intCollectionID : intCollectionID = ""
 Dim allCollections : Set allCollections = objSWbemServices.ExecQuery("SELECT * FROM SMS_Collection WHERE Name = '" & strName & "'")
 For Each strCollection In allCollections
  intCollectionID = strCollection.CollectionID
 Next

 CollectionNameToID = intCollectionID
 
End Function

Programmatically creating AppV Deployments in ConfigMgr

When creating AppV Packages programmatically in ConfigMgr there are some things to consider as they do have programs like classic packages. It's important that the program name is the following string: [Virtual application]. If you use asterisk (*) or a any other string the package will not install.

Here's a example how to create an AppV Program in VB.Net

Set objNewProgram = oWMIService.Get("SMS_Program").SpawnInstance_()
objNewProgram.ProgramName = "[Virtual application]"
objNewProgram.PackageID = strPackageID

If you want to create a Task Sequence which installs a AppV package you've also to define this string as the program name.

Set objTSAction = connection.Get("SMS_TaskSequence_InstallSoftwareAction").SpawnInstance_
objTSAction.PackageID=strPackageID
objTSAction.ProgramName="[Virtual application]" 
objTSAction.Name=strName

Advertisement on state "WaitingDisabled"

An App-V Package which you try to deploy does not get installed.
If the App-V Package is assigned directly the Advertisement is not displayed in "Run advertised Programs". If the Package is assigned over a Task Sequence the Advertisement is visible, but cannot be executed.
In both cases the following Errors are shown:

In CAS.log and Execmgr.log Client logfiles it looks like that the sources are found, but it ends up with the message that no sourcefiles could be located.
Download location found 1
Matching DP Location found 0

Also the state of the Advertisement is on WaitingDisabled

The ConfigMgr behaviour is this case is correct, cause App-V is not active on your ConfigMgr Site

Solution: Enable the AppV deployment on your site in the Client Agent Settings -> Advertised Programs Client Agent -> "Allow virtual application package advertisement"

Restricted Users cannot create a Direct Membership Rule on a Collection programmatically in SCCM

Consider the following scenario:
You have a User in SCCM 2007 who has only restricted permissions in SCCM. For example the User can just read and modify some specific collections, import computers and create Collection Membership Rules. When the User is using the SCCM Console there’s no problem and all tasks can be performed.
You have written a tool (vbscript, vb.net or whatever) which makes this User possible to perform some tasks very easy and fast on your SCCM Server. The User can import a new machine (with name and mac address), but when trying to create a Direct Membership Rule the tools crashes with “Generic failure”.
If you check the smsprov.log file on your SCCM Server you get this error message:
User … has no read resource rights in any collection for this ResourceID

The problem is that you cannot define a “Default Collection” in the SCCM API where the machine is member of from the beginning. As the User has no Read Rights on the all Collections Class it cannot find that Machine and so it cannot create the Membership Rule. Even if you catch the machine’s ResourceID from the ImportMachineEntry function when creating the machine you the tool crashes.

Either you give the User read Permissions for the all Collections Class Rights, (but then the User can see all Machines in SCCM) or you use the following workaround:
When importing the machine entry there’s created a Status Message on your Site Server. This message looks like listed below and has the Message ID 30213:
User "XYZ" imported machine at site "SiteServer - SiteCode" (NetbiosName=YourMachineName, MACAddress=F7:E8:D3:A9:84:FE, SMBIOSGUID=).
Now create a Status Filter Rule which gets triggered from when this MessageID occurs and start a script with the following command line:
cscript.exe YourScript.vbs %msgis04
%msgis04 later contains the Machine name which you have created.
Now the script runs with the Local System Account of your SCCM Server and must create a Collection Membership Rule on any collection:

Any part of this script would look like this:

strComputername  = Wscript.Arguments(0)
strCollectionID = “XYZ“
Set instCollection = objSWbemServices.Get("SMS_Collection.CollectionID='" &strCollectionID & "'")
Set instDirectRule = objSWbemServices.Get("SMS_CollectionRuleDirect").SpawnInstance_
instDirectRule.ResourceClassName = "SMS_R_System"
instDirectRule.ResourceID = NameTOResourceID(strComputerName)
instDirectRule.RuleName = strComputername
instCollection.AddMembershipRule(instDirectRule)

After the script has been executed the Users tool should be able to create the Direct Membership Rule.

AddOn: Maybe you have to build in a “wait-routine” in the Users tool until the Machine’s name get resolved into a ResourceID

Do
objSWbemServices.ExecQuery("SELECT * FROM SMS_R_System WHERE Name = '" & strComputerName & "'"
Loop While objSWbemServices.Count = 0

Switch from Local System to User context

Sometimes there’s a need to switch from Local System context to the current logged on User.
The following article describes how to achieve this.

In short words the following happens:
1. Something is executed in local system context
2. At the end a EventLog entry is written
3. A Scheduled Tasks gets trigged by the created EventLog entry
4. The Scheduled Tasks which is running in User context executes another script

One example is e.g. to inform Users about an Installation which was executed from the Local System Account. The Application Deployment process executes the CreateEventToInform.vbs Script at the end of the installation to create the EventLog entry for informing the User

CreateEventToInform.vbs

Dim objShell : Set objShell = CreateObject("WScript.Shell")
Dim strMessage : strMessage = "Dear User this is a message from your local system"
objShell.LogEvent(4, strMessage)

InformUser.vbs

Dim strMessage
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & "."
& "\root\cimv2")
Set colLoggedEvents = objWMIService.ExecQuery("Select * from Win32_NTLogEvent Where Logfile = 'Application' and SourceName='WSH' and EventCode=4 and Type='Information'")

For Each objEvent In colLoggedEvents
strMessage = objEvent.Message
Exit For
Next

MsgBox(strMessage, vbInformation + vbOKOnly, "Your Company")

It could also be used as an immediately executed “ActiveSetup” for the current logged User. The Application Deployment process executes the CreateEventToExecute.vbs Script at the end of the installation to create the EventLog entry for performing a Active Setup for the current User

CreateEventToExecute.vbs

Dim objShell : Set objShell = CreateObject("WScript.Shell")
Dim strCommandLine : strCommandLine = "msiexex /fup "
objShell.LogEvent(4, strCommandLine)

ExecuteUserPart.vbs

Dim objShell : Set objShell = CreateObject("Wscript.Shell")
Dim strCommandLine
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & "." & "\root\cimv2")
Set colLoggedEvents = objWMIService.ExecQuery("Select * from Win32_NTLogEvent Where Logfile = 'Application' and SourceName='WSH' and EventCode=4 and Type='Information'")

For Each objEvent In colLoggedEvents
strCommandLine = objEvent.Message
Exit For
Next

objShell.Run(strCommandLine, 1, False)

To make the whole think work we have to create a trigger which reacts to the EventLog Entry which was created. Create a Scheduled Tasks which is executed in the User context as listed below for this

Note: You can deploy scheduled tasks to many computer automatically e.g. with Group Policies

Now as soon as the EventID is written the Scheduled Tasks executes the below listed command



Further thoughts:
You could create a whole Application which is written variable so that you can perform different actions in User context. To achieve this easily you could tag the EventLog Message with specific keywords. Later the Application parses the EventLog Message and you can react on this. So you can use it for different scenarios. Example:

WriteEventLog.vbs

Dim objShell : Set objShell = CreateObject("WScript.Shell")
Dim strMessage : strMessage = "[Inform]Dear User now there's happening something" &vbNewLine &"[Execute]msiexex /fup "
objShell.LogEvent 4, strMessage

PerformInUserContext.vbs

Dim objShell : objShell = CreateObject("Wscript.Shell")
Dim strMessage, arrEventEntry
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & "." & "\root\cimv2")
Set colLoggedEvents = objWMIService.ExecQuery("Select * from Win32_NTLogEvent Where Logfile = 'Application' and SourceName='WSH' and EventCode=4 and Type='Information'")

For Each objEvent In colLoggedEvents
strMessage = objEvent.Message
Exit For
Next

arrEventEntry = Split(strMessage, vbNewLine)

For Each strLine In arrEventEntry
If InStr(strLine, "[Inform]") Then
MsgBox(Replace(strLine, "[Inform]", ""))
ElseIf InStr(strLine, "[Execute]") Then
objShell.Run(Replace(strLine, "[Execute]", ""), 1, False)
End If
Next