vbScript - Get running environment

The following vbScript Function delivers the value true if the script runs within a task sequence environment. If not the functions delivers the value false. This function can be useful in scripts like wrapper and so on.

...
If RunningInTaskSequence = True Then
...

Function RunningInTaskSequence()
 On Error Resume Next
 Err.Clear
   Dim objTSEnv : Set objTSEnv = CreateObject("Microsoft.SMS.TSEnvironment")
 If Err Then
  'Script does not run within the Task Sequence environment
     RunningInTaskSequence = False
 Else
  'Script does run within the Task Sequence environment
  RunningInTaskSequence = True
 End If
 On Error GoTo 0
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