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

vbScript - Migrate Reports from SMS to SCCM

This script will migrate all advertisements from on site sms/sccm to another one. It should also migrate the prompts in the report. But this is a very tricky part
Be careful: Never run the script in your production until you've tested it!!!

On Error Resume Next
Option Explicit

Dim strSourceServer : strSourceServer = "SMSServer"
Dim strTargetServer : strTargetServer = "SCCMServer"
Dim strSourceSiteCode : strSourceSiteCode = "000"
Dim strTargetSiteCode : strTargetSiteCode = "000"
Dim objSourceWMIService, objTargetWMIService
dim AllReports, objReport, newReport
Dim AllContainers, objContainer
Dim objLazyProperties, Path, Report
Dim strNewContainerID
Dim AllParameters, objParameter
Dim intContainerObjectType : intContainerObjectType = 8
Dim objReportParams, strReportParamClass, newReportParam
Dim bolReportParamsAvailable : bolReportParamsAvailable = False
Dim intReportParameterCount : intReportParameterCount = 0
Dim arrTempParam()


Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objLogFile : Set objLogFile = objFSO.CreateTextFile("MigrateReports.log")

Set objSourceWMIService = GetObject("winmgmts://" & strSourceServer & "\root\sms\site_" & strSourceSiteCode)
Set objTargetWMIService = GetObject("winmgmts://" & strTargetServer & "\root\sms\site_" & strTargetSiteCode)

'Creating all Containers
Call CreateContainer

'Only Reports in SubContainers
'Set AllContainers = objSourceWMIService.ExecQuery("SELECT * FROM SMS_ObjectContainerItem WHERE ObjectType='" &intContainerObjectType &"'") 
'For Each objContainer In AllContainers
 
 'Set AllReports = objSourceWMIService.ExecQuery("SELECT * FROM SMS_Report WHERE SecurityKey='" &objContainer.InstanceKey &"'")
 Set AllReports = objSourceWMIService.ExecQuery("SELECT * FROM SMS_Report")
 
 For Each objReport In AllReports
 
  'Check if there are Report parameter
  Set objReport = objSourceWMIService.Get("SMS_Report.ReportID=" & objReport.ReportID)   
  On Error Resume Next
  
  'For each Parameter in the Report
  For i = 0 To UBound(objReport.ReportParams)
   Set objReportParams = objReport.ReportParams(i)
   strReportParamClass=objReportParams.Path_.Class
   If strReportParamClass = "SMS_ReportParameter" Then
    bolReportParamsAvailable = True
    ReDim Preserve arrTempParam(i)

    Set newReportParam = objSourceWMIService.Get("SMS_ReportParameter").SpawnInstance_
    newReportParam.VariableName = objReportParams.VariableName
    newReportParam.PromptText = objReportParams.PromptText
    newReportParam.DefaultValue = objReportParams.DefaultValue
    newReportParam.AllowEmpty = objReportParams.AllowEmpty
    newReportParam.SampleValueSQL = objReportParams.SampleValueSQL
    
    Set arrTempParam(i) = newReportParam
    objLogFile.WriteLine Now &" - Report Parameter available " &objReport.Name
    
   Else
    bolReportParamsAvailable = False
    objLogFile.WriteLine Now &" - No Report Parameter (skipping) " &objReport.Name
    End If
  Next
  On Error GoTo 0
  
  
  For Each item In arrTempParam
   WScript.Echo item.VariableName
  Next
 
  Set newReport = objTargetWMIService.Get("SMS_Report").SpawnInstance_
    
    newReport.Category = objReport.Category
   newReport.Comment = objReport.Comment
   newReport.DrillThroughColumns = objReport.DrillThroughColumns
   newReport.DrillThroughURL = objReport.DrillThroughURL
   newReport.GraphCaption = objReport.GraphCaption
   newReport.GraphType = objReport.GraphType
   newReport.GraphXCol = objReport.GraphXCol
   newReport.GraphYCol = objReport.GraphYCol
   newReport.Name = "NEW " &objReport.Name
   newReport.NumPrompts = objReport.NumPrompts
   newReport.RefreshInterval = objReport.RefreshInterval
  
   If bolReportParamsAvailable = true Then 
    newReport.ReportParams = arrTempParam
    
    bolReportParamsAvailable = False
    Set objReportParams = Nothing
    Set newReportParam = Nothing
    strReportParamClass = ""
  End If
   
   newReport.StatusMessageDetailSource = objReport.StatusMessageDetailSource
   newReport.XColLabel = objReport.XColLabel
   newReport.YColLabel = objReport.YColLabel
   newReport.DrillThroughReportID = objReport.DrillThroughReportID
   newReport.DrillThroughReportPath = objReport.DrillThroughReportPath
   newReport.MachineDetail = objReport.MachineDetail
   newReport.MachineSource = objReport.MachineSource
  
  'Get SQL Query of the Report and Count the Report Parameter
  Set objLazyProperties = objSourceWMIService.Get("SMS_Report.ReportID=" &objReport.ReportID)
  intReportParameterCount = Len(objLazyProperties.SQLQuery) - Len(Replace(objLazyProperties.SQLQuery, "@", ""))
  newReport.SQLQuery = objLazyProperties.SQLQuery
  
   If objLazyProperties Is Nothing Then
    objLogFile.WriteLine Now &" - Error: Cannot read SQLQuery from Report " &objReport.Name &". Skipping this Report"
   Else
    objLogFile.WriteLine Now &" - Creating Report "  &objReport.Name
    
    'Write the instance to WMI
    Path = newReport.Put_()
   
    'Get automatically assigned package ID
    'Set Report=objTargetWMIService.Get(Path)
     
    'Getting new Container ID
    'strNewContainerID = GetNewContainerID(ContainerIDToName( objContainer.ContainerNodeID))
   
    'Moving the Report into the Container
    'Call MoveReportInToContainer(strNewContainerID, Report.SecurityKey)
    
    'Clean up
    Set objLazyProperties = Nothing 
   End If

 Next
'Next

WScript.Echo "Done"

Sub CreateContainer

Dim AllSourceContainer, objSourceContainer
Dim objTargetContainer

    Set AllSourceContainer = objSourceWMIService.ExecQuery("SELECT * FROM SMS_ObjectContainerNode WHERE ObjectType='" &intContainerObjectType &"'")
    For Each objSourceContainer In AllSourceContainer
  
     objLogFile.WriteLine Now &" - Migrating Container " &objSourceContainer.Name
        Set objTargetContainer = objTargetWMIService.Get("SMS_ObjectContainerNode").SpawnInstance_()
     objTargetContainer.Name = objSourceContainer.Name
     objTargetContainer.ObjectType = objSourceContainer.ObjectType
     objTargetContainer.ParentContainerNodeID = objSourceContainer.ParentContainerNodeID
     On Error Resume Next
     objTargetContainer.Put_
     On Error GoTo 0
    
    Next
    
End Sub

Function ContainerIDToName(ContainerID)
Dim AllContainers, objContainer

Set AllContainers = objSourceWMIService.ExecQuery("SELECT * FROM SMS_ObjectContainerNode WHERE ObjectType='" &intContainerObjectType &"' AND ContainerNodeID='" &ContainerID &"'") 
For Each objContainer In AllContainers
 ContainerIDToName = objContainer.Name
Next

End Function

Function GetNewContainerID(ContainerName)
Dim AllSourceContainer, objSourceContainer
 
Set AllSourceContainer = objTargetWMIService.ExecQuery("SELECT * FROM SMS_ObjectContainerNode WHERE ObjectType='" &intContainerObjectType &"' and Name = '" &ContainerName &"'")

For Each objSourceContainer In AllSourceContainer
 GetNewContainerID = objSourceContainer.ContainerNodeID
Next

End Function

Function MoveReportInToContainer(ContainerID, ReportID)
Dim folderItem

If ContainerID <> "" Then

 objLogFile.WriteLine Now &" - Moving Report " &ReportID &" into Container " &ContainerID
 
 Set folderItem = objTargetWMIService.Get("SMS_ObjectContainerItem").SpawnInstance_()
 folderItem.InstanceKey = ReportID
 folderItem.ObjectType = "8"
 folderItem.ContainerNodeID = ContainerID
 folderItem.Put_
Else
 objLogFile.WriteLine Now &" - No need to move the Report " &ReportID &", because it's listed in the root"
End If
    
End Function

vbScript - Migrate Advertisements from SMS to SCCM

This script will migrate all advertisements from on site sms/sccm to another one
Be careful: Never run the script in your production until you've tested it!!!

'On Error Resume Next
'Option Explicit

Dim strSourceServer : strSourceServer = "SMSServer"
Dim strTargetServer : strTargetServer = "SCCMServer"
Dim strSourceSiteCode : strSourceSiteCode = "000"
Dim strTargetSiteCode : strTargetSiteCode = "000"
Dim objSourceWMIService, objTargetWMIService
Dim AllPackages, objPackage
Dim strProgramName, strCurPackageVersion, strCurpackageLanguage, strCurPackageManufacturer
Dim Token, schedule, schedtype
Dim Path
Dim strNewCollectionsID, strNewPackageID, strNewContainerID
Dim AllAdvertisements, objAdvertisement, newAdvertisement, Advertisement
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objLogFile : Set objLogFile = objFSO.CreateTextFile("MigrateAdvertisements.log")

Set objSourceWMIService = GetObject("winmgmts://" & strSourceServer & "\root\sms\site_" & strSourceSiteCode)
Set objTargetWMIService = GetObject("winmgmts://" & strTargetServer & "\root\sms\site_" & strTargetSiteCode)

'Creating Container
Call CreateContainer

Set AllAdvertisements = objSourceWMIService.ExecQuery("Select * From SMS_Advertisement") 
For Each objAdvertisement In AllAdvertisements
 
 strProgramName = objAdvertisement.ProgramName
 objLogFile.WriteLine Now &" - The program " &strProgramName  &" is assigned to the Advertisement " &objAdvertisement.AdvertisementName
   
 'Get Container ID of the Advertisement
 strNewContainerID = GetNewContainerID(ContainerIDToName(GetContainerID(objAdvertisement.AdvertisementID)))
 objLogFile.WriteLine Now &" - New ContainerID for Advertisement " &objAdvertisement.AdvertisementName &" is " &strNewContainerID
 
 'Get New Collections ID
 strNewCollectionsID = GetNewCollectionsID(CollectionIDToName(objAdvertisement.CollectionID))
 objLogFile.WriteLine Now &" - The CollectionID " &strNewCollectionsID &" will be assigned to " &objAdvertisement.AdvertisementName
 
 'Get New Package ID
 strNewPackageID = GetNewPackageID(PackageIDToName(objAdvertisement.PackageID))
 objLogFile.WriteLine Now &" - The PackageID  " &strNewPackageID &" will be assigned to  " &objAdvertisement.AdvertisementName
 
 'Create Advertisement
 If  strNewCollectionsID <> "" And  strProgramName <> "" And  strNewPackageID <> "" Then
  Set newAdvertisement = objTargetWMIService.Get("SMS_Advertisement").SpawnInstance_()
  Set lazyproperties = objSourceWMIService.get("sms_advertisement.advertisementid='" & objAdvertisement.advertisementid & "'")

  newAdvertisement.assignedscheduleenabled = lazyproperties.assignedscheduleenabled
  newAdvertisement.assignedscheduleisgmt = lazyproperties.assignedscheduleisgmt
      newAdvertisement.expirationtimeenabled = lazyproperties.expirationtimeenabled
      newAdvertisement.expirationtimeisgmt = lazyproperties.expirationtimeisgmt
      newAdvertisement.assignedschedule = lazyproperties.assignedschedule
      newAdvertisement.presenttimeisgmt=lazyproperties.presenttimeisgmt

  newAdvertisement.AdvertisementName = objAdvertisement.AdvertisementName
  newAdvertisement.AdvertFlags= objAdvertisement.AdvertFlags
  newAdvertisement.CollectionID = strNewCollectionsID
  newAdvertisement.DeviceFlags = DeviceFlags
  newAdvertisement.comment = objAdvertisement.Comment 
  newAdvertisement.ExpirationTime= objAdvertisement.ExpirationTime
  newAdvertisement.HierarchyPath = objAdvertisement.HierarchyPath
  newAdvertisement.IncludeSubCollection = objAdvertisement.IncludeSubCollection
  newAdvertisement.PackageID = strNewPackageID
  newAdvertisement.PresentTime=objAdvertisement.PresentTime
  newAdvertisement.PresentTimeEnabled=objAdvertisement.PresentTimeEnabled
  newAdvertisement.ProgramName = strProgramName
  newAdvertisement.RemoteClientFlags = objAdvertisement.RemoteClientFlags
  newAdvertisement.Priority = objAdvertisement.Priority
  newAdvertisement.TimeFlags = objAdvertisement.TimeFlags
  Path = newAdvertisement.Put_
  
  'Get automatically assigned Advertisement ID
  Set Advertisement=objTargetWMIService.Get(Path)
  'Moving the Advertisements into Container
  Call MoveAdvertisementInToContainer(strNewContainerID, Advertisement.AdvertisementID)
  
 Else
  objLogFile.WriteLine Now &" - ERROR: Advertisement " &objAdvertisement.AdvertisementName  &" could not be migrated. Maybe a Collection, Package or Program does not exist"
 End If
 
 strProgramName = ""
 strNewPackageID = ""
 strNewCollectionsID = ""
 
Next
WScript.Echo "Done"
 
 
Function CollectionIDToName(CollectionID)
Dim AllCollections, objCollection

Set AllCollections = objSourceWMIService.ExecQuery("SELECT * FROM SMS_Collection WHERE CollectionID='" &CollectionID &"'") 
For Each objCollection In AllCollections
 CollectionIDToName = objCollection.Name
Next
End Function

Function GetNewCollectionsID(CollectionName)
Dim AllCollections, objCollection

Set AllCollections = objTargetWMIService.ExecQuery("SELECT * FROM SMS_Collection WHERE Name='" &CollectionName &"'") 
For Each objCollection In AllCollections
 GetNewCollectionsID = objCollection.CollectionID
Next
End Function
 
Function PackageIDToName(PackageID)
Dim AllPackages, objPackage

Set AllPackages = objSourceWMIService.ExecQuery("SELECT * FROM SMS_Package WHERE PackageID='" &PackageID &"'") 
For Each objPackage In AllPackages
 PackageIDToName = objPackage.Name
 strCurPackageVersion = objPackage.Version
 strCurPackageManufacturer = objPackage.Manufacturer
 strCurpackageLanguage = objPackage.Language
Next
End Function

Function GetNewPackageID(PackageName)
Dim AllPackages, objPackage

'Make sure the Correct Package is choosen
Set AllPackages = objTargetWMIService.ExecQuery("SELECT * FROM SMS_Package WHERE Name='" &PackageName _
                   &"' AND Version='" &strCurPackageVersion _ 
                   &"' AND Language='" &strCurpackageLanguage _ 
                   &"' AND Manufacturer='" &strCurPackageManufacturer &"'")

For Each objPackage In AllPackages
 GetNewPackageID = objPackage.PackageID
Next
strCurPackageVersion = ""
strCurpackageLanguage = ""
strCurPackageManufacturer = ""
End Function

Sub CreateContainer

Dim AllSourceContainer, objSourceContainer
Dim objTargetContainer

    Set AllSourceContainer = objSourceWMIService.ExecQuery("SELECT * FROM SMS_ObjectContainerNode WHERE ObjectType='3'")
    For Each objSourceContainer In AllSourceContainer
    
     objLogFile.WriteLine Now &" - Migrating Container " &objSourceContainer.Name
        Set objTargetContainer = objTargetWMIService.Get("SMS_ObjectContainerNode").SpawnInstance_()
     objTargetContainer.Name = objSourceContainer.Name
     objTargetContainer.ObjectType = objSourceContainer.ObjectType
     objTargetContainer.ParentContainerNodeID = objSourceContainer.ParentContainerNodeID
     On Error Resume Next
     objTargetContainer.Put_
     On Error GoTo 0
    
    Next
    
End Sub
  
Function MoveAdvertisementInToContainer(ContainerID, AdvertisementID)
Dim folderItem

If ContainerID <> "" Then

 objLogFile.WriteLine Now &" - Moving Advertisement " &AdvertisementID &" into Container " &ContainerID
 
 Set folderItem = objTargetWMIService.Get("SMS_ObjectContainerItem").SpawnInstance_()
 folderItem.InstanceKey = AdvertisementID
 folderItem.ObjectType = "3"
 folderItem.ContainerNodeID = ContainerID
 folderItem.Put_
Else
 objLogFile.WriteLine Now &" - No need to move the Advertisement " &AdvertisementID &", because it's listed in the root"
End If
    
End Function

Function GetContainerID(AdvertisementID)
Dim AllContainers, objContainer

Set AllContainers = objSourceWMIService.ExecQuery("SELECT * FROM SMS_ObjectContainerItem WHERE ObjectType='3' AND InstanceKey='" &AdvertisementID &"'") 
For Each objContainer In AllContainers
 GetContainerID = objContainer.ContainerNodeID
Next

End Function

Function ContainerIDToName(ContainerID)
Dim AllContainers, objContainer

Set AllContainers = objSourceWMIService.ExecQuery("SELECT * FROM SMS_ObjectContainerNode WHERE ObjectType='3' AND ContainerNodeID='" &ContainerID &"'") 
For Each objContainer In AllContainers
 ContainerIDToName = objContainer.Name
Next

End Function

Function GetNewContainerID(ContainerName)
Dim AllSourceContainer, objSourceContainer
 
Set AllSourceContainer = objTargetWMIService.ExecQuery("SELECT * FROM SMS_ObjectContainerNode WHERE ObjectType='3' and Name = '" &ContainerName &"'")

For Each objSourceContainer In AllSourceContainer
 GetNewContainerID = objSourceContainer.ContainerNodeID
Next
End Function

vbScript - Migrate Packages from SMS to SCCM

This script will migrate all packages from on site sms/sccm to another one
Be careful: Never run the script in your production until you've tested it!!!

'Option Explicit
On Error Resume Next
Dim strSourceServer : strSourceServer = "SMSServer"
Dim strTargetServer : strTargetServer = "SCCMServer"
Dim strSourceSiteCode : strSourceSiteCode = "000"
Dim strTargetSiteCode : strTargetSiteCode = "000"
Dim strNewSourcePath : strNewSourcePath = "SCCMServer"
Dim strOldSourcePath : strOldSourcePath = "SMSServer"
Dim objSourceWMIService, objTargetWMIService
Dim objPackage, AllPackages
Dim strContainerID, strContainerName
Dim bolScheduleAvailable : bolScheduleAvailable = False
Dim Token, schedule, schedtype
Dim strPkgManufacturer, strPkgName, strPkgVersion, strPkgLanguage, strPkgDescription, strPkgSource, strPkgSourceFlag
Dim strPkgExtendedData, strPkgExtendedDataSize, strPkgForcedDisconnectDelay, strPkgForcedDisconnectEnabled
Dim strPkgForcedDisconnectRetries, strPkgIcon, strPkgiconSize,strPkgIgnoreAddressSchedule,strPkgFlags, strPkgPriority
Dim strPkgMIFName, strPkgMIFPublisher, srtPktMIFVersion, strPkgMIFFilename, strPkgPreferedAddressType
Dim strPkgRefreshSourceFlag, strPkgShareName, strPkgShareType, strPkgSourceData, strPkgSourceVersion
Dim strNewPackageID
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objLogFile : Set objLogFile = objFSO.CreateTextFile("MigratePackages.log")

Set objSourceWMIService = GetObject("winmgmts://" & strSourceServer & "\root\sms\site_" & strSourceSiteCode)
Set objTargetWMIService = GetObject("winmgmts://" & strTargetServer & "\root\sms\site_" & strTargetSiteCode)

objLogFile.WriteLine Now &" - Migrating Packages from " &strSourceServer &" to " &strTargetServer

'First create all Containers
Call CreateContainer

'Loop trought all packages exsisting on the source server
Set AllPackages = objSourceWMIService.ExecQuery("SELECT * FROM SMS_Package") 
For Each objPackage In AllPackages
 
 objLogFile.WriteLine Now &" - Migrating Package " &objPackage.PackageID
 
 'Get Package settings
 strPkgName = objPackage.Name
 strPkgManufacturer = objPackage.Manufacturer
 strPkgVersion = objPackage.Version
 strPkgLanguage = objPackage.Language
 strPkgDescription = objPackage.Description
 strPkgSource = objPackage.PkgSourcePath
 strPkgSourceFlag = objPackage.PkgSourceFlag
 strPkgExtendedData = objPackage.extendedData
 strPkgExtendedDataSize = objPackage.extendedDataSize
 strPkgForcedDisconnectDelay = objPackage.forcedDisconnectDelay
 strPkgForcedDisconnectEnabled = objPackage.forcedDisconnectEnabled
 strPkgForcedDisconnectRetries = objPackage.forcedDisconnectNumretries
 strPkgIcon = objPackage.Icon
 strPkgiconSize = objPackage.IconSize
 strPkgIgnoreAddressSchedule = objPackage.IgnoreAddressSchedule
 strPkgMIFFilename = objPackage.MifFileName
 strPkgMIFName = objPackage.MifName
 strPkgMIFPublisher = objPackage.MifPublisher
 srtPktMIFVersion = objPackage.MifVersion
 strPkgFlags = objPackage.PKGFlags
 strPkgPreferedAddressType = objPackage.PreferredAddressType
 strPkgPriority = objPackage.Priority
 strPkgRefreshSourceFlag = objPackage.RefreshPkgSourceFlag
 strPkgShareName = objPackage.ShareName
 strPkgShareType = objPackage.ShareType
 strPkgSourceData = objPackage.SourceDate
 strPkgSourceVersion = objPackage.SourceVersion 
 
 'Get Package Refresh Schedule
 Set objPackage = objSourceWMIService.Get("SMS_Package='" & objPackage.PackageID & "'" ) 
 On Error Resume Next
 Set schedule = objPackage.RefreshSchedule(0)
 On Error GoTo 0
 
 
 If err.number = 424 Then
     objLogFile.WriteLine Now &" - Package has no Schedule  " &objPackage.PackageID
 ElseIf err.number <> 0 Then
  objLogFile.WriteLine Now &" - An Error (" &err.number  &") occured while getting the Refresh Schedule from " &objPackage.PackageID
 Else
  On Error Resume Next
  schedtype=Schedule.Path_.Class
  
  Select Case (schedtype)
   Case "SMS_ST_RecurInterval"
     Set Token = objTargetWMIService.Get("SMS_ST_RecurInterval").SpawnInstance_()
     If schedule.MinuteSpan <> 0 Then Token.MinuteSpan = schedule.MinuteSpan
     If schedule.HourSpan <> 0 Then Token.HourSpan = schedule.HourSpan
     If schedule.DaySpan <> 0 Then Token.DaySpan = schedule.DaySpan
     If schedule.MinuteDuration <> 0 Then Token.MinuteDuration = schedule.MinuteDuration
     If schedule.HourDuration <> 0 Then Token.HourDuration = schedule.HourDuration
     If schedule.DayDuration <> 0 Then Token.DayDuration = schedule.DayDuration
     Token.StartTime = schedule.StartTime
     
     bolScheduleAvailable = True
     objLogFile.WriteLine Now &" - SMS_ST_RecurInterval Schedule available " &objPackage.PackageID
     
   Case "SMS_ST_RecurWeekly"
     Set Token = objTargetWMIService.Get("SMS_ST_RecurWeekly").SpawnInstance_()
     If schedule.MinuteDuration <> 0 Then Token.MinuteDuration = schedule.MinuteDuration
     If schedule.HourDuration <> 0 Then Token.HourDuration = schedule.HourDuration
     If schedule.DayDuration <> 0 Then Token.DayDuration = schedule.DayDuration
     If schedule.ForNumberOfWeeks <> 0 Then Token.ForNumberOfWeeks = schedule.ForNumberOfWeeks
     If schedule.Day <> 0 Then Token.Day = schedule.Day
     Token.StartTime = schedule.StartTime
     
     bolScheduleAvailable = True
     objLogFile.WriteLine Now &" - SMS_ST_RecurWeekly Schedule available " &objPackage.PackageID
     
   Case "SMS_ST_RecurMonthlyByDate"
     Set Token = objTargetWMIService.Get("SMS_ST_RecurMonthlyByDate").SpawnInstance_()
     If schedule.MinuteDuration <> 0 Then Token.MinuteDuration = schedule.MinuteDuration
     If schedule.HourDuration <> 0 Then Token.HourDuration = schedule.HourDuration
     If schedule.DayDuration <> 0 Then Token.DayDuration = schedule.DayDuration
     If schedule.ForNumberOfMonths <> 0 Then Token.ForNumberOfMonths = schedule.ForNumberOfMonths
     If schedule.MonthDay <> 0 Then Token.MonthDay = schedule.MonthDay
     Token.StartTime = schedule.StartTime
     
    bolScheduleAvailable = True
    objLogFile.WriteLine Now &" - SMS_ST_RecurMonthlyByDate Schedule available " &objPackage.PackageID
    
   Case "SMS_ST_RecurMonthlyByWeekday"
     Set Token = objTargetWMIService.Get("SMS_ST_RecurMonthlyByWeekday").SpawnInstance_()
     If schedule.MinuteDuration <> 0 Then Token.MinuteDuration = schedule.MinuteDuration
     If schedule.HourDuration <> 0 Then Token.HourDuration = schedule.HourDuration
     If schedule.DayDuration <> 0 Then Token.DayDuration = schedule.DayDuration
     If schedule.ForNumberOfMonths <> 0 Then Token.ForNumberOfMonths = schedule.ForNumberOfMonths
     If schedule.WeekOrder <> 0 Then Token.WeekOrder = schedule.WeekOrder

     Token.StartTime = schedule.StartTime
    objLogFile.WriteLine Now &" - SMS_ST_RecurMonthlyByWeekday Schedule available " &objPackage.PackageID
     
    bolScheduleAvailable = True

   Case "SMS_ST_NonRecurring"
     Set Token = objTargetWMIService.Get("SMS_ST_NonRecurring").SpawnInstance_()
     If schedule.MinuteDuration <> 0 Then Token.MinuteDuration = schedule.MinuteDuration
     If schedule.HourDuration <> 0 Then Token.HourDuration = schedule.HourDuration
     If schedule.DayDuration <> 0 Then Token.DayDuration = schedule.DayDuration
     Token.StartTime = schedule.StartTime
     
    bolScheduleAvailable = True
    objLogFile.WriteLine Now &" - SMS_ST_NonRecurring Schedule available " &objPackage.PackageID
     
    Case Else
    bolScheduleAvailable = False
    objLogFile.WriteLine Now &" - Unknown Schedule (skipping) " &objPackage.PackageID
  End Select
     
   End If
 

 'Get the container id of the package
 strContainerID = GetContainerID(objPackage.PackageID)
 
 'Get the containers name of the package
 strContainerName = ContainerIDToName(strContainerID)
 objLogFile.WriteLine Now &" - Old Container of the Package is " &strContainerName
 
 'Get the new containers id
 strNewContainerID = GetNewContainerID(strContainerName)
 objLogFile.WriteLine Now &" - New Container ID of the Package is " &strNewContainerID

 'Create the Package and get the new Package ID
 strNewPackageID = CreatePackage()
 
 Call CreatePrograms(objPackage.PackageID, strNewPackageID)
 
 'Move the Package into the Container
 Call MovePackageInToContainer(strNewContainerID, strNewPackageID)
 

Next

WScript.Echo "Done"
objLogFile.WriteLine Now &" - Finish"
 

Sub CreateContainer

Dim AllSourceContainer, objSourceContainer
Dim objTargetContainer

    Set AllSourceContainer = objSourceWMIService.ExecQuery("SELECT * FROM SMS_ObjectContainerNode WHERE ObjectType='2'")
    For Each objSourceContainer In AllSourceContainer
    
     objLogFile.WriteLine Now &" - Migrating Container " &objSourceContainer.Name
        Set objTargetContainer = objTargetWMIService.Get("SMS_ObjectContainerNode").SpawnInstance_()
     objTargetContainer.Name = objSourceContainer.Name
     objTargetContainer.ObjectType = objSourceContainer.ObjectType
     objTargetContainer.ParentContainerNodeID = objSourceContainer.ParentContainerNodeID
     On Error Resume Next
     objTargetContainer.Put_
     On Error GoTo 0
    
    Next
    
End Sub

Function GetContainerID(PackageID)
Dim AllContainers, objContainer

Set AllContainers = objSourceWMIService.ExecQuery("SELECT * FROM SMS_ObjectContainerItem WHERE ObjectType='2' AND InstanceKey='" &PackageID &"'") 
For Each objContainer In AllContainers
 GetContainerID = objContainer.ContainerNodeID
Next

End Function

Function GetNewContainerID(ContainerName)
Dim AllSourceContainer, objSourceContainer
 
Set AllSourceContainer = objTargetWMIService.ExecQuery("SELECT * FROM SMS_ObjectContainerNode WHERE ObjectType='2' and Name = '" &ContainerName &"'")

For Each objSourceContainer In AllSourceContainer
 GetNewContainerID = objSourceContainer.ContainerNodeID
Next

End Function

Function ContainerIDToName(ContainerID)
Dim AllContainers, objContainer

Set AllContainers = objSourceWMIService.ExecQuery("SELECT * FROM SMS_ObjectContainerNode WHERE ObjectType='2' AND ContainerNodeID='" &ContainerID &"'") 
For Each objContainer In AllContainers
 ContainerIDToName = objContainer.Name
Next

End Function

Function CreatePackage()
Dim newPackage, PKGSourcePath
Dim Package

 objLogFile.WriteLine Now &" - Creating the Package " &strPkgManufacturer &" " &strPkgName &" " &strPkgVersion &" " &strPkgLanguage

    Set newPackage = objTargetWMIService.Get("SMS_Package").SpawnInstance_

    newPackage.Name = strPkgName
 newPackage.Description = strPkgDescription 
 newPackage.extendedData = strPkgExtendedData
 newPackage.extendedDataSize = strPkgExtendedDataSize 
 newPackage.forcedDisconnectDelay = strPkgForcedDisconnectDelay
 newPackage.forcedDisconnectEnabled = strPkgForcedDisconnectEnabled
 newPackage.forcedDisconnectNumretries = strPkgForcedDisconnectRetries
 newPackage.Icon = strPkgIcon
 newPackage.IconSize =  strPkgiconSize
 newPackage.IgnoreAddressSchedule = strPkgIgnoreAddressSchedule
 newPackage.Language = strPkgLanguage 
 newPackage.Manufacturer = strPkgManufacturer
 newPackage.MifFileName = strPkgMIFFilename
 newPackage.MifName = strPkgMIFName
 newPackage.MifPublisher = strPkgMIFPublisher
 newPackage.MifVersion = srtPktMIFVersion
 newPackage.PKGFlags = strPkgFlags
 newPackage.PkgSourceFlag = strPkgSourceFlag
 PKGSourcePath= Replace(Lcase(strPkgSource),Lcase(strOldSourcePath),Lcase(strNewSourcePath)) 
 newPackage.PkgSourcePath = PKGSourcePath
 newPackage.PreferredAddressType = strPkgPreferedAddressType
 newPackage.Priority = strPkgPriority
 newPackage.RefreshPkgSourceFlag =  strPkgRefreshSourceFlag
 newPackage.ShareName =  strPkgShareName
 newPackage.ShareType =  strPkgShareType
 newPackage.SourceDate = strPkgSourceData
 newPackage.SourceVersion= strPkgSourceVersion
 newPackage.Version = strPkgVersion 
 
 'Create Refresh Schedule for Package
 If bolScheduleAvailable = True Then
  newPackage.RefreshSchedule = Array(Token)
 End If

    Path = newPackage.Put_
    
 'Get automatically assigned package ID
 Set Package=objTargetWMIService.Get(Path)
 CreatePackage = Package.PackageID


'Clean Variables
On Error Resume Next
Set Token = Nothing
Set schedule = Nothing
Set newPackage = Nothing
bolScheduleAvailable = False
schedtype = ""

End Function

Function MovePackageInToContainer(ContainerID, PackageID)
Dim folderItem

If ContainerID <> "" Then

 objLogFile.WriteLine Now &" - Moving Package " &PackageID &" into Container " &ContainerID
 
 Set folderItem = objTargetWMIService.Get("SMS_ObjectContainerItem").SpawnInstance_()
 folderItem.InstanceKey = PackageID
 folderItem.ObjectType = "2"
 folderItem.ContainerNodeID = ContainerID
 folderItem.Put_
Else
 objLogFile.WriteLine Now &" - No need to move the Package " &PackageID &", because it's listed in the root"
End If
    
End Function

Function CreatePrograms(OldPackageID, NewPackageID)
Dim AllPrograms, objProgram
Dim newProgram

Set AllPrograms = objSourceWMIService.ExecQuery("SELECT * FROM SMS_Program WHERE PackageID='" &OldPackageID &"'")
If Not AllPrograms Is Nothing Then
 For Each objProgram In AllPrograms
 
  objLogFile.WriteLine Now &" - Creating the Program " &objProgram.ProgramName &" in Package " &OldPackageID
 
  Set newProgram = objTargetWMIService.Get("SMS_Program").SpawnInstance_() 
  newProgram.CommandLine = objProgram.commandline
  newProgram.Comment = objProgram.comment
  newProgram.Description = objProgram.description
  newProgram.Deviceflags = objProgram.deviceflags
  newProgram.DiskSpaceReq = objProgram.DiskSpaceReq
  newProgram.DriveLetter = objProgram.DriveLetter
  newProgram.Duration = objProgram.Duration
  newProgram.extendedData = objProgram.extendedData
  newProgram.extendedDataSize = objProgram.extendedDataSize
  newProgram.icon = objProgram.icon
  newProgram.iconsize = objProgram.iconSize
  newProgram.MSIFilePath = objProgram.MSIFilePath
  newProgram.MSIProductID = objProgram.MSIProductID
  newProgram.PackageID = NewPackageID
  newProgram.ProgramFlags = objProgram.ProgramFlags
  newProgram.ProgramName = objProgram.ProgramName
  newProgram.RemovalKey = objProgram.RemovalKey
  newProgram.Requirements = objProgram.Requirements
  newProgram.SupportedOperatingSystems = objProgram.SupportedOperatingSystems
  newProgram.WorkingDirectory = objProgram.WorkingDirectory
   On Error Resume Next
   newProgram.Put_
 Next
End If

End Function

vbScript - Migrate Collections from SMS to SCCM

This script will migrate all collections from on site sms/sccm to another one
Be careful: Never run the script in your production until you've tested it!!!

Option Explicit
'On Error Resume Next
Dim strSourceServer : strSourceServer = "SMSServer"
Dim strTargetServer : strTargetServer = "SCCMServer"
Dim strSourceSiteCode : strSourceSiteCode = "000"
Dim strTargetSiteCode : strTargetSiteCode = "000"
dim intRuleCounter : intRuleCounter = 0
dim strRuleName(100)
Dim strRuleQuery(100)
Dim strLimitToColl(100)
Dim strCollectionRefType
Dim strCollectionRefShd
Dim Token, schedule, schedtype
Dim bolScheduleAvailable : bolScheduleAvailable = False
Dim objSourceWMIService, objTargetWMIService
Dim AllCollections, objCollection
Dim strCollectionName, strCollectionComment
Dim AllParentCollections, objParentCollections, strParentCollectionName, strNewParentCollectionID
Dim objRules, RuleSet
Dim bolLimitCollExisting : bolLimitCollExisting = False
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objLogFile : Set objLogFile = objFSO.CreateTextFile("MigrateCollections.log")

Set objSourceWMIService = GetObject("winmgmts://" & strSourceServer & "\root\sms\site_" & strSourceSiteCode)
Set objTargetWMIService = GetObject("winmgmts://" & strTargetServer & "\root\sms\site_" & strTargetSiteCode)

objLogFile.WriteLine Now &" - Migrating Collections from " &strSourceServer &" to " &strTargetServer

'Loop trought all collections exsisting on the source server
Set AllCollections = objSourceWMIService.ExecQuery("SELECT * FROM SMS_Collection WHERE NAME NOT LIKE 'All%' AND NAME NOT LIKE 'Root%'") 
For Each objCollection In AllCollections
 strCollectionName = objCollection.Name
 strCollectionComment = objCollection.Comment
 
 objLogFile.WriteLine Now &" - Now migrating the Collection  " &objCollection.Name

 Set objCollection = objSourceWMIService.Get("SMS_Collection='" & objCollection.CollectionID & "'" ) 
 
 'Get Collection schedule
 On Error Resume Next
 Set schedule=objCollection.RefreshSchedule(0)
 On Error GoTo 0
 
 If err.number = 424 Then
     objLogFile.WriteLine Now &" - Collection has no Schedule  " &objCollection.Name
 ElseIf err.number <> 0 Then
  objLogFile.WriteLine Now &" - An Error (" &err.number  &") occured while getting the Update Schedule from " &objCollection.Name
 Else
  On Error Resume Next
  schedtype=Schedule.Path_.Class
  
  Select Case (schedtype)
   Case "SMS_ST_RecurInterval"
     Set Token = objTargetWMIService.Get("SMS_ST_RecurInterval").SpawnInstance_()
     If schedule.MinuteSpan <> 0 Then Token.MinuteSpan = schedule.MinuteSpan
     If schedule.HourSpan <> 0 Then Token.HourSpan = schedule.HourSpan
     If schedule.DaySpan <> 0 Then Token.DaySpan = schedule.DaySpan
     If schedule.MinuteDuration <> 0 Then Token.MinuteDuration = schedule.MinuteDuration
     If schedule.HourDuration <> 0 Then Token.HourDuration = schedule.HourDuration
     If schedule.DayDuration <> 0 Then Token.DayDuration = schedule.DayDuration
     Token.StartTime = schedule.StartTime
     
     bolScheduleAvailable = True
     objLogFile.WriteLine Now &" - SMS_ST_RecurInterval Schedule available " &objCollection.Name
     
   Case "SMS_ST_RecurWeekly"
     Set Token = objTargetWMIService.Get("SMS_ST_RecurWeekly").SpawnInstance_()
     If schedule.MinuteDuration <> 0 Then Token.MinuteDuration = schedule.MinuteDuration
     If schedule.HourDuration <> 0 Then Token.HourDuration = schedule.HourDuration
     If schedule.DayDuration <> 0 Then Token.DayDuration = schedule.DayDuration
     If schedule.ForNumberOfWeeks <> 0 Then Token.ForNumberOfWeeks = schedule.ForNumberOfWeeks
     If schedule.Day <> 0 Then Token.Day = schedule.Day
     Token.StartTime = schedule.StartTime
     
     bolScheduleAvailable = True
     objLogFile.WriteLine Now &" - SMS_ST_RecurWeekly Schedule available " &objCollection.Name
     
   Case "SMS_ST_RecurMonthlyByDate"
     Set Token = objTargetWMIService.Get("SMS_ST_RecurMonthlyByDate").SpawnInstance_()
     If schedule.MinuteDuration <> 0 Then Token.MinuteDuration = schedule.MinuteDuration
     If schedule.HourDuration <> 0 Then Token.HourDuration = schedule.HourDuration
     If schedule.DayDuration <> 0 Then Token.DayDuration = schedule.DayDuration
     If schedule.ForNumberOfMonths <> 0 Then Token.ForNumberOfMonths = schedule.ForNumberOfMonths
     If schedule.MonthDay <> 0 Then Token.MonthDay = schedule.MonthDay
     Token.StartTime = schedule.StartTime
     
    bolScheduleAvailable = True
    objLogFile.WriteLine Now &" - SMS_ST_RecurMonthlyByDate Schedule available " &objCollection.Name
    
   Case "SMS_ST_RecurMonthlyByWeekday"
     Set Token = objTargetWMIService.Get("SMS_ST_RecurMonthlyByWeekday").SpawnInstance_()
     If schedule.MinuteDuration <> 0 Then Token.MinuteDuration = schedule.MinuteDuration
     If schedule.HourDuration <> 0 Then Token.HourDuration = schedule.HourDuration
     If schedule.DayDuration <> 0 Then Token.DayDuration = schedule.DayDuration
     If schedule.ForNumberOfMonths <> 0 Then Token.ForNumberOfMonths = schedule.ForNumberOfMonths
     If schedule.WeekOrder <> 0 Then Token.WeekOrder = schedule.WeekOrder

     Token.StartTime = schedule.StartTime
    objLogFile.WriteLine Now &" - SMS_ST_RecurMonthlyByWeekday Schedule available " &objCollection.Name
     
    bolScheduleAvailable = True

   Case "SMS_ST_NonRecurring"
     Set Token = objTargetWMIService.Get("SMS_ST_NonRecurring").SpawnInstance_()
     If schedule.MinuteDuration <> 0 Then Token.MinuteDuration = schedule.MinuteDuration
     If schedule.HourDuration <> 0 Then Token.HourDuration = schedule.HourDuration
     If schedule.DayDuration <> 0 Then Token.DayDuration = schedule.DayDuration
     Token.StartTime = schedule.StartTime
     
    bolScheduleAvailable = True
    objLogFile.WriteLine Now &" - SMS_ST_NonRecurring Schedule available " &objCollection.Name
     
    Case Else
    bolScheduleAvailable = False
    objLogFile.WriteLine Now &" - Unknown Schedule (skipping) " &objCollection.Name
  End Select
     
   End If
 
 'Get Collection Rules
  If Not IsNull(objCollection.CollectionRules) Then
   objRules = objCollection.CollectionRules

   For Each RuleSet In objRules
    intRuleCounter = intRuleCounter + 1
    strRuleName(intRuleCounter) = RuleSet.Rulename
    strRuleQuery(intRuleCounter) = RuleSet.QueryExpression
    If RuleSet.LimitToCollectionID <> "" Then
      strLimitToColl(intRuleCounter) = LimitColID
    End If

    objLogFile.WriteLine Now &" - Collection Rule will be migrated " &strRuleName(intRuleCounter)
   Next
  Else
   'WScript.Echo "Collection without Rules: " &strCollectionName
   set strRuleName(0) = Nothing
   Set strRuleName(0) = Nothing
   intRuleCounter = 0
    objLogFile.WriteLine Now &" - No Collection Rule available"
  End If
 
 
  'Get Parent Collection
 Set AllParentCollections = objSourceWMIService.ExecQuery("SELECT parentCollectionID FROM SMS_CollectToSubCollect WHERE subCollectionID = '" &objCollection.CollectionID &"'")
 For Each objParentCollections In AllParentCollections
  'Determine the parent collections name
  strParentCollectionName = GetParentCollectionName(objParentCollections.parentCollectionID)
  objLogFile.WriteLine Now &" - Parent Collections name is " &strParentCollectionName
  
  'Determine the parent collections id on the target server
  strNewParentCollectionID = GetNewParentCollectionID(strParentCollectionName)
  objLogFile.WriteLine Now &" - New Parent Collections ID is " &strNewParentCollectionID
 Next

 'Create the new collection
 Call CreateCollection(strCollectionName, strCollectionComment, strNewParentCollectionID)
 
Next


Function GetParentCollectionName(CollectionID)
 
Set AllParentCollections = objSourceWMIService.ExecQuery("SELECT Name FROM SMS_Collection WHERE CollectionID = '" &CollectionID &"'")

For Each objParentCollections In AllParentCollections
 GetParentCollectionName = objParentCollections.Name
Next

End Function

Function GetNewParentCollectionID(CollectionName)
 
Set AllParentCollections = objTargetWMIService.ExecQuery("SELECT CollectionID FROM SMS_Collection WHERE Name = '" &CollectionName &"'")
For Each objParentCollections In AllParentCollections
 GetNewParentCollectionID = objParentCollections.CollectionID
Next

End Function

Function CreateCollection(CollectionName, CollectionComment, ParentCollectionID)

Dim newCollection
Dim collectionPath
Dim newSubCollectToSubCollect
Dim queryRule, newQueryRule
Dim newCollectionRule
Dim i

' Create the collection.
Set newCollection = objTargetWMIService.Get("SMS_Collection").SpawnInstance_
newCollection.Comment = CollectionComment
newCollection.Name = CollectionName
newCollection.OwnedByThisSite = True
objLogFile.WriteLine Now &" - Collection created " &CollectionName

'Create Update Schedule for Collection
If bolScheduleAvailable = True Then
 newCollection.RefreshSchedule = Array(Token)
 newCollection.RefreshType = 2
End If
objLogFile.WriteLine Now &" - Configured Collection Schedule " &CollectionName
 
Set collectionPath = newCollection.Put_    
    
'Set Parent Collection
Set newSubCollectToSubCollect = objTargetWMIService.Get("SMS_CollectToSubCollect").SpawnInstance_
newSubCollectToSubCollect.parentCollectionID = ParentCollectionID
newSubCollectToSubCollect.subCollectionID = CStr(collectionPath.Keys("CollectionID"))
newSubCollectToSubCollect.Put_
objLogFile.WriteLine Now &" - Configured th Parent Collection " &CollectionName

'Create Query Memebership Rule
Set queryRule = objTargetWMIService.Get("SMS_CollectionRuleQuery")
Set newCollection = objTargetWMIService.Get(collectionPath.RelPath)
        
For i = 1 To intRuleCounter
 'Create the query rule.
 Set newQueryRule = QueryRule.SpawnInstance_
 newQueryRule.QueryExpression = strRuleQuery(i)
 newQueryRule.RuleName = strRuleName(i)
 If strLimitToColl(i) <> "" Then newQueryRule.LimitToCollectionID = strLimitToColl(i)
 'Add the new query rule to a variable.
 Set newCollectionRule = newQueryRule
 'Add the rules to the collection.
 newCollection.AddMembershipRule newCollectionRule
Next
objLogFile.WriteLine Now &" - Added Collection Rules " &CollectionName
  
'Call RequestRefresh to initiate the collection evaluator.
newCollection.RequestRefresh False

'Clean Variables
On Error Resume Next
Set Token = Nothing
Set schedule = Nothing
Set newCollection = Nothing
bolScheduleAvailable = False
schedtype = ""
intRuleCounter = 0
On Error GoTo 0

End Function
objLogFile.WriteLine Now &" - Finish"
WScript.Echo "Done"

SCCM SQL Query - Get all Computer objects which are not member of a specific collection and it's subcollections

This SQL query will return each computer which is not member of your defined collection and it's subcollections

select Name0 From v_R_System Where v_R_System.Name0 not in(
select  v_R_System.Name0 from v_R_System inner join v_ClientCollectionMembers on (v_R_System.ResourceID = v_ClientCollectionMembers.ResourceID)
inner join v_CollectToSubCollect on (v_CollectToSubCollect.subCollectionID = v_ClientCollectionMembers.CollectionID)
Where v_CollectToSubCollect.parentCollectionID = 'YourCollectionID')
order By Name0

It's also possible with muliple start collection

select Name0 From v_R_System Where v_R_System.Name0 not in(
select  v_R_System.Name0 from v_R_System inner join v_ClientCollectionMembers on (v_R_System.ResourceID = v_ClientCollectionMembers.ResourceID)
inner join v_CollectToSubCollect on (v_CollectToSubCollect.subCollectionID = v_ClientCollectionMembers.CollectionID)
Where v_CollectToSubCollect.parentCollectionID In('YourCollectionID1','YourCollectionID2','YourCollectionID3'))
Order By Name0