July 6, 2016

Extract Drivers

This script will extract all drivers from a computer and copy them to a folder structure organized by type. It is language dependent and currently works for Danish and English Operating System language.

Option Explicit
Dim WshShell, oExec
Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec("Dism.exe /online /get-drivers")
WScript.Echo "Started, Get drivers"
Dim iCounter
iCounter = 0
Do While oExec.Status = 0 And iCounter < 600
WScript.Sleep 100
iCounter = iCounter + 1
Loop
WScript.Echo "Execute time: " & iCounter / 10 & " Sec."
WScript.Echo "Exit Code: " & oExec.ExitCode
Dim sText, sDriverList
Dim aDriverList()
Dim iDriversCount
iDriversCount = 0
Do While Not oExec.StdOut.AtEndOfStream
sText = oExec.StdOut.ReadLine()
If Left(sText,17) = "Published Name : " Or Left(sText,17) = "Udgivelsesnavn : " Then
ReDim Preserve aDriverList(iDriversCount)
aDriverList(iDriversCount) = Trim(Right(sText,Len(sText)-17))
iDriversCount = iDriversCount + 1
End If
Loop
Dim sElement
Dim aOEMDriverPaths(), aOEMDriverClasses(), aOEMDriverVersion()
WScript.Echo "Number of OEM Drivers: " & iDriversCount
iDriversCount = 0
For Each sElement In aDriverList
Set oExec = WshShell.Exec("Dism.exe /online /get-driverInfo:" & sElement)
WScript.Echo "Started, get info for driver: " & sElement
iCounter = 0
Do While oExec.Status = 0 And iCounter < 100
WScript.Sleep 100
iCounter = iCounter + 1
Loop
WScript.Echo "Execute time: " & iCounter / 10 & " Sec."
WScript.Echo "Exit Code: " & oExec.ExitCode
Do While Not oExec.StdOut.AtEndOfStream
sText = oExec.StdOut.ReadLine()
If Left(sText,20) = "Driver Store Path : " Then
ReDim Preserve aOEMDriverPaths(iDriversCount)
aOEMDriverPaths(iDriversCount) = Trim(Right(sText,Len(sText)-20))
End If
If Left(sText,22) = "Sti til driverlager : " Then
ReDim Preserve aOEMDriverPaths(iDriversCount)
aOEMDriverPaths(iDriversCount) = Trim(Right(sText,Len(sText)-22))
End If
If Left(sText,13) = "Class Name : " Or Left(sText,13) = "Klassenavn : "Then
ReDim Preserve aOEMDriverClasses(iDriversCount)
aOEMDriverClasses(iDriversCount) = Trim(Right(sText,Len(sText)-13))
End If
If Left(sText,10) = "Version : " Then
ReDim Preserve aOEMDriverVersion(iDriversCount)
aOEMDriverVersion(iDriversCount) = Trim(Right(sText,Len(sText)-10))
iDriversCount = iDriversCount + 1
End If
Loop
Next
Dim sScriptPath, sDriversDestinationPath
sScriptPath = Left(wscript.scriptfullname, Len(wscript.scriptfullname) - Len(wscript.scriptname))
Wscript.echo sScriptPath
Dim sComputer, oWMIService, cItems, oItem, sManufacturer, sModel
sComputer = "."
Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\CIMV2")
Set cItems = oWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem",,48)
For Each oItem in cItems
sManufacturer = oItem.Manufacturer
sModel = oItem.Model
Next
WScript.Echo "Number of OEM Drivers: " & iDriversCount
Dim sInfFileName, sDriverVersion, sDriverCopySource, sDriverCopyDistination, iWaitCounter
For iCounter = 0 To iDriversCount-1
sInfFileName = Right(aOEMDriverPaths(iCounter),Len(aOEMDriverPaths(iCounter))-InstrRev(aOEMDriverPaths(iCounter),"\",-1,vbTextCompare))
sInfFileName = Left(sInfFileName,Len(sInfFileName)-4)
sDriverVersion = aOEMDriverVersion(iCounter)
sDriversDestinationPath = sScriptPath & "Drivers\" & sManufacturer & "\" & sModel & "\"
sDriverCopySource = Left(aOEMDriverPaths(iCounter),InstrRev(aOEMDriverPaths(iCounter),"\",-1,vbTextCompare))
sDriverCopyDistination = sDriversDestinationPath & aOEMDriverClasses(iCounter) & "\" & sInfFileName & "_" & sDriverVersion
WScript.echo "Copy Driver: " & aOEMDriverClasses(iCounter) & " " & sInfFileName & " " & sDriverVersion
CopyFolder sDriverCopySource, sDriverCopyDistination, "Precompiled Setup Information"
Next
Function CopyFolder(sSourceFolder, sDestinationFolder, sExcludeType)
SearchSubFolders sSourceFolder, sDestinationFolder, sExcludeType
End Function
Sub SearchSubFolders(sSourceFoldersPath, sDestFoldersPath, sExcludeType)
Dim oFileSystem, oFolder, oFile, aExcludeType, bExclude, sElement
Set oFileSystem = CreateObject("Scripting.FileSystemObject")
aExcludeType = Split(sExcludeType,",",-1,vbTextCompare)
'** Søg i under mapper ************************************************************
Set oFolder = oFileSystem.getFolder(sSourceFoldersPath)
For Each ofile in oFolder.SubFolders
SearchSubFolders sSourceFoldersPath & "\" & oFile.name, sDestFoldersPath & "\" & oFile.name, sExcludeType
Next
'** Kopier filer i mappe **********************************************************
For Each oFile in oFolder.Files
bExclude = False
For Each sElement In aExcludeType
If UCase(oFile.Type) = UCase(sElement) Then
bExclude = True
End If
Next
If Not bExclude Then
CopyFile sSourceFoldersPath, sDestFoldersPath, oFile.name
End If
Next
Set oFolder = Nothing
Set oFileSystem = nothing
End Sub
Function CopyFile(sSourceFilePath, sDestFilePath, sFile)
Dim oFileSystem, oCopyFile, oCopyFileDest, iSecondsDateDiff
Set oFileSystem = CreateObject("Scripting.FileSystemObject")
'** Kontroller om destinations filen findes ****************************************
If oFileSystem.FileExists(sDestFilePath & "\" & sFile) Then
'** Destinations fil eksisterer, kontroller om kilde fil er nyere **********
Set oCopyFile = oFileSystem.GetFile(sSourceFilePath & "\" & sFile)
Set oCopyFileDest = oFileSystem.GetFile(sDestFilePath & "\" & sFile)
iSecondsDateDiff = DateDiff("s", oCopyFile.DateLastModified, oCopyFileDest.DateLastModified)
If iSecondsDateDiff < 0 Then
'** Kilde Fil er nyere, kopier fil *********************************
On Error resume Next
oCopyFile.Copy (sDestFilePath & "\" & sFile)
If Err.Number = 0 Then
'wscript.echo "File copied: " & sSourceFilePath & "\" & sFile
Else
'** Fejl i kopiering, log fejl *****************************
wscript.echo "ERROR " & Err.Number & " copy file: " & sSourceFilePath & "\" & sFile
End If
On Error Goto 0
End If
Set oCopyFile = nothing
Set oCopyFileDest = nothing
Else
'** Destination findes ikke, kopier fil ************************************
Set oCopyFile = oFileSystem.GetFile(sSourceFilePath & "\" & sFile)
CreateFolderTree(sDestFilePath)
On Error resume Next
oCopyFile.Copy (sDestFilePath & "\" & sFile)
'** Slet kilde fil, hvis kopiering gik godt ********************************
If Err.Number = 0 Then
'wscript.echo "File copied: " & sSourceFilePath & "\" & sFile
Else
'** Fejl i kopiering, log fejl *************************************
wscript.echo "Error " & Err.Number & " copy file: " & sSourceFilePath & "\" & sFile
End If
On Error Goto 0
Set oCopyFile = nothing
End If
Set oFileSystem = nothing
End Function
'******************************************************************************
Function CreateFolderTree(strInput)
Dim objFileSystemObject
Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
If Not objFileSystemObject.FolderExists(strInput) Then
Dim arrFolderPath,intFolder,strFolderTree
arrFolderPath = Split(strInput,"\")
For intFolder = 0 To UBound(arrFolderPath)
strFolderTree = strFolderTree & arrFolderPath(intFolder) & "\"
If intFolder > 1 Then
If Not objFileSystemObject.FolderExists(strFolderTree) Then
objFileSystemObject.CreateFolder(strFolderTree)
End If
End If
Next
CreateFolderTree = True
Else
CreateFolderTree = False
End If
Set objFileSystemObject = nothing
End Function
Option Explicit Dim WshShell, oExec Set WshShell = CreateObject("WScript.Shell") Set oExec = WshShell.Exec("Dism.exe /online /get-drivers") WScript.Echo "Started, Get drivers" Dim iCounter iCounter = 0 Do While oExec.Status = 0 And iCounter < 600 WScript.Sleep 100 iCounter = iCounter + 1 Loop WScript.Echo "Execute time: " & iCounter / 10 & " Sec." WScript.Echo "Exit Code: " & oExec.ExitCode Dim sText, sDriverList Dim aDriverList() Dim iDriversCount iDriversCount = 0 Do While Not oExec.StdOut.AtEndOfStream sText = oExec.StdOut.ReadLine() If Left(sText,17) = "Published Name : " Or Left(sText,17) = "Udgivelsesnavn : " Then ReDim Preserve aDriverList(iDriversCount) aDriverList(iDriversCount) = Trim(Right(sText,Len(sText)-17)) iDriversCount = iDriversCount + 1 End If Loop Dim sElement Dim aOEMDriverPaths(), aOEMDriverClasses(), aOEMDriverVersion() WScript.Echo "Number of OEM Drivers: " & iDriversCount iDriversCount = 0 For Each sElement In aDriverList Set oExec = WshShell.Exec("Dism.exe /online /get-driverInfo:" & sElement) WScript.Echo "Started, get info for driver: " & sElement iCounter = 0 Do While oExec.Status = 0 And iCounter < 100 WScript.Sleep 100 iCounter = iCounter + 1 Loop WScript.Echo "Execute time: " & iCounter / 10 & " Sec." WScript.Echo "Exit Code: " & oExec.ExitCode Do While Not oExec.StdOut.AtEndOfStream sText = oExec.StdOut.ReadLine() If Left(sText,20) = "Driver Store Path : " Then ReDim Preserve aOEMDriverPaths(iDriversCount) aOEMDriverPaths(iDriversCount) = Trim(Right(sText,Len(sText)-20)) End If If Left(sText,22) = "Sti til driverlager : " Then ReDim Preserve aOEMDriverPaths(iDriversCount) aOEMDriverPaths(iDriversCount) = Trim(Right(sText,Len(sText)-22)) End If If Left(sText,13) = "Class Name : " Or Left(sText,13) = "Klassenavn : "Then ReDim Preserve aOEMDriverClasses(iDriversCount) aOEMDriverClasses(iDriversCount) = Trim(Right(sText,Len(sText)-13)) End If If Left(sText,10) = "Version : " Then ReDim Preserve aOEMDriverVersion(iDriversCount) aOEMDriverVersion(iDriversCount) = Trim(Right(sText,Len(sText)-10)) iDriversCount = iDriversCount + 1 End If Loop Next Dim sScriptPath, sDriversDestinationPath sScriptPath = Left(wscript.scriptfullname, Len(wscript.scriptfullname) - Len(wscript.scriptname)) Wscript.echo sScriptPath Dim sComputer, oWMIService, cItems, oItem, sManufacturer, sModel sComputer = "." Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\CIMV2") Set cItems = oWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem",,48) For Each oItem in cItems sManufacturer = oItem.Manufacturer sModel = oItem.Model Next WScript.Echo "Number of OEM Drivers: " & iDriversCount Dim sInfFileName, sDriverVersion, sDriverCopySource, sDriverCopyDistination, iWaitCounter For iCounter = 0 To iDriversCount-1 sInfFileName = Right(aOEMDriverPaths(iCounter),Len(aOEMDriverPaths(iCounter))-InstrRev(aOEMDriverPaths(iCounter),"\",-1,vbTextCompare)) sInfFileName = Left(sInfFileName,Len(sInfFileName)-4) sDriverVersion = aOEMDriverVersion(iCounter) sDriversDestinationPath = sScriptPath & "Drivers\" & sManufacturer & "\" & sModel & "\" sDriverCopySource = Left(aOEMDriverPaths(iCounter),InstrRev(aOEMDriverPaths(iCounter),"\",-1,vbTextCompare)) sDriverCopyDistination = sDriversDestinationPath & aOEMDriverClasses(iCounter) & "\" & sInfFileName & "_" & sDriverVersion WScript.echo "Copy Driver: " & aOEMDriverClasses(iCounter) & " " & sInfFileName & " " & sDriverVersion CopyFolder sDriverCopySource, sDriverCopyDistination, "Precompiled Setup Information" Next Function CopyFolder(sSourceFolder, sDestinationFolder, sExcludeType) SearchSubFolders sSourceFolder, sDestinationFolder, sExcludeType End Function Sub SearchSubFolders(sSourceFoldersPath, sDestFoldersPath, sExcludeType) Dim oFileSystem, oFolder, oFile, aExcludeType, bExclude, sElement Set oFileSystem = CreateObject("Scripting.FileSystemObject") aExcludeType = Split(sExcludeType,",",-1,vbTextCompare) '** Søg i under mapper ************************************************************ Set oFolder = oFileSystem.getFolder(sSourceFoldersPath) For Each ofile in oFolder.SubFolders SearchSubFolders sSourceFoldersPath & "\" & oFile.name, sDestFoldersPath & "\" & oFile.name, sExcludeType Next '** Kopier filer i mappe ********************************************************** For Each oFile in oFolder.Files bExclude = False For Each sElement In aExcludeType If UCase(oFile.Type) = UCase(sElement) Then bExclude = True End If Next If Not bExclude Then CopyFile sSourceFoldersPath, sDestFoldersPath, oFile.name End If Next Set oFolder = Nothing Set oFileSystem = nothing End Sub Function CopyFile(sSourceFilePath, sDestFilePath, sFile) Dim oFileSystem, oCopyFile, oCopyFileDest, iSecondsDateDiff Set oFileSystem = CreateObject("Scripting.FileSystemObject") '** Kontroller om destinations filen findes **************************************** If oFileSystem.FileExists(sDestFilePath & "\" & sFile) Then '** Destinations fil eksisterer, kontroller om kilde fil er nyere ********** Set oCopyFile = oFileSystem.GetFile(sSourceFilePath & "\" & sFile) Set oCopyFileDest = oFileSystem.GetFile(sDestFilePath & "\" & sFile) iSecondsDateDiff = DateDiff("s", oCopyFile.DateLastModified, oCopyFileDest.DateLastModified) If iSecondsDateDiff < 0 Then '** Kilde Fil er nyere, kopier fil ********************************* On Error resume Next oCopyFile.Copy (sDestFilePath & "\" & sFile) If Err.Number = 0 Then 'wscript.echo "File copied: " & sSourceFilePath & "\" & sFile Else '** Fejl i kopiering, log fejl ***************************** wscript.echo "ERROR " & Err.Number & " copy file: " & sSourceFilePath & "\" & sFile End If On Error Goto 0 End If Set oCopyFile = nothing Set oCopyFileDest = nothing Else '** Destination findes ikke, kopier fil ************************************ Set oCopyFile = oFileSystem.GetFile(sSourceFilePath & "\" & sFile) CreateFolderTree(sDestFilePath) On Error resume Next oCopyFile.Copy (sDestFilePath & "\" & sFile) '** Slet kilde fil, hvis kopiering gik godt ******************************** If Err.Number = 0 Then 'wscript.echo "File copied: " & sSourceFilePath & "\" & sFile Else '** Fejl i kopiering, log fejl ************************************* wscript.echo "Error " & Err.Number & " copy file: " & sSourceFilePath & "\" & sFile End If On Error Goto 0 Set oCopyFile = nothing End If Set oFileSystem = nothing End Function '****************************************************************************** Function CreateFolderTree(strInput) Dim objFileSystemObject Set objFileSystemObject = CreateObject("Scripting.FileSystemObject") If Not objFileSystemObject.FolderExists(strInput) Then Dim arrFolderPath,intFolder,strFolderTree arrFolderPath = Split(strInput,"\") For intFolder = 0 To UBound(arrFolderPath) strFolderTree = strFolderTree & arrFolderPath(intFolder) & "\" If intFolder > 1 Then If Not objFileSystemObject.FolderExists(strFolderTree) Then objFileSystemObject.CreateFolder(strFolderTree) End If End If Next CreateFolderTree = True Else CreateFolderTree = False End If Set objFileSystemObject = nothing End Function
Option Explicit

Dim WshShell, oExec
Set WshShell = CreateObject("WScript.Shell")

Set oExec = WshShell.Exec("Dism.exe /online /get-drivers")

WScript.Echo "Started, Get drivers"

Dim iCounter
iCounter = 0
Do While oExec.Status = 0 And iCounter < 600
	WScript.Sleep 100
	iCounter = iCounter + 1
Loop

WScript.Echo "Execute time: " & iCounter / 10 & " Sec."
WScript.Echo "Exit Code: " & oExec.ExitCode

Dim sText, sDriverList
Dim aDriverList()
Dim iDriversCount
iDriversCount = 0
Do While Not oExec.StdOut.AtEndOfStream
	sText = oExec.StdOut.ReadLine()
	If Left(sText,17) = "Published Name : " Or Left(sText,17) = "Udgivelsesnavn : " Then
		ReDim Preserve aDriverList(iDriversCount)
		aDriverList(iDriversCount) = Trim(Right(sText,Len(sText)-17))
		iDriversCount = iDriversCount + 1
	End If
Loop

Dim sElement
Dim aOEMDriverPaths(), aOEMDriverClasses(), aOEMDriverVersion()

WScript.Echo "Number of OEM Drivers: " & iDriversCount

iDriversCount = 0
For Each sElement In aDriverList
	
	Set oExec = WshShell.Exec("Dism.exe /online /get-driverInfo:" & sElement)

	WScript.Echo "Started, get info for driver: " & sElement

	iCounter = 0
	Do While oExec.Status = 0 And iCounter < 100
		WScript.Sleep 100
		iCounter = iCounter + 1
	Loop

	WScript.Echo "Execute time: " & iCounter / 10 & " Sec."
	WScript.Echo "Exit Code: " & oExec.ExitCode

	Do While Not oExec.StdOut.AtEndOfStream
		sText = oExec.StdOut.ReadLine()
		If Left(sText,20) = "Driver Store Path : " Then
			ReDim Preserve aOEMDriverPaths(iDriversCount)
			aOEMDriverPaths(iDriversCount) = Trim(Right(sText,Len(sText)-20))
		End If
		If Left(sText,22) = "Sti til driverlager : " Then
			ReDim Preserve aOEMDriverPaths(iDriversCount)
			aOEMDriverPaths(iDriversCount) = Trim(Right(sText,Len(sText)-22))
		End If
						    
		If Left(sText,13) = "Class Name : " Or Left(sText,13) = "Klassenavn : "Then
			ReDim Preserve aOEMDriverClasses(iDriversCount)
			aOEMDriverClasses(iDriversCount) = Trim(Right(sText,Len(sText)-13))
		End If
		If Left(sText,10) = "Version : " Then
			ReDim Preserve aOEMDriverVersion(iDriversCount)
			aOEMDriverVersion(iDriversCount) = Trim(Right(sText,Len(sText)-10))
			iDriversCount = iDriversCount + 1
		End If
	Loop
Next

Dim sScriptPath, sDriversDestinationPath
sScriptPath = Left(wscript.scriptfullname, Len(wscript.scriptfullname) - Len(wscript.scriptname))

Wscript.echo sScriptPath

Dim sComputer, oWMIService, cItems, oItem, sManufacturer, sModel
sComputer = "." 
Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\CIMV2") 
Set cItems = oWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem",,48) 
For Each oItem in cItems
    sManufacturer = oItem.Manufacturer
    sModel = oItem.Model
Next

WScript.Echo "Number of OEM Drivers: " & iDriversCount

Dim sInfFileName, sDriverVersion, sDriverCopySource, sDriverCopyDistination, iWaitCounter


For iCounter = 0 To iDriversCount-1

	sInfFileName = Right(aOEMDriverPaths(iCounter),Len(aOEMDriverPaths(iCounter))-InstrRev(aOEMDriverPaths(iCounter),"\",-1,vbTextCompare))
	sInfFileName = Left(sInfFileName,Len(sInfFileName)-4)
	sDriverVersion = aOEMDriverVersion(iCounter)
	sDriversDestinationPath = sScriptPath & "Drivers\" & sManufacturer & "\" & sModel & "\"
	sDriverCopySource = Left(aOEMDriverPaths(iCounter),InstrRev(aOEMDriverPaths(iCounter),"\",-1,vbTextCompare))
	sDriverCopyDistination = sDriversDestinationPath & aOEMDriverClasses(iCounter) & "\" & sInfFileName & "_" & sDriverVersion

	WScript.echo "Copy Driver: " & aOEMDriverClasses(iCounter) & " " & sInfFileName & " " & sDriverVersion

	CopyFolder sDriverCopySource, sDriverCopyDistination, "Precompiled Setup Information"
Next

Function CopyFolder(sSourceFolder, sDestinationFolder, sExcludeType)
	SearchSubFolders sSourceFolder, sDestinationFolder, sExcludeType
End Function

Sub SearchSubFolders(sSourceFoldersPath, sDestFoldersPath, sExcludeType)

	Dim oFileSystem, oFolder, oFile, aExcludeType, bExclude, sElement
	Set oFileSystem = CreateObject("Scripting.FileSystemObject")
	aExcludeType = Split(sExcludeType,",",-1,vbTextCompare)

	'** Søg i under mapper ************************************************************
	Set oFolder = oFileSystem.getFolder(sSourceFoldersPath)
	For Each ofile in oFolder.SubFolders
		SearchSubFolders sSourceFoldersPath & "\" & oFile.name, sDestFoldersPath & "\" & oFile.name, sExcludeType
	Next

	'** Kopier filer i mappe **********************************************************
	For Each oFile in oFolder.Files

		bExclude = False
		For Each sElement In aExcludeType
			If UCase(oFile.Type) = UCase(sElement) Then
				bExclude = True
			End If
		Next
		If Not bExclude Then
			CopyFile sSourceFoldersPath, sDestFoldersPath, oFile.name
		End If
	Next
	Set oFolder = Nothing
	Set oFileSystem = nothing

End Sub


Function CopyFile(sSourceFilePath, sDestFilePath, sFile)

	Dim oFileSystem, oCopyFile, oCopyFileDest, iSecondsDateDiff
	Set oFileSystem = CreateObject("Scripting.FileSystemObject")

	'** Kontroller om destinations filen findes ****************************************
	If oFileSystem.FileExists(sDestFilePath & "\" & sFile) Then

		'** Destinations fil eksisterer, kontroller om kilde fil er nyere **********
		Set oCopyFile = oFileSystem.GetFile(sSourceFilePath & "\" & sFile)
		Set oCopyFileDest = oFileSystem.GetFile(sDestFilePath & "\" & sFile)
		iSecondsDateDiff = DateDiff("s", oCopyFile.DateLastModified, oCopyFileDest.DateLastModified)
		If iSecondsDateDiff < 0 Then

			'** Kilde Fil er nyere, kopier fil *********************************
			On Error resume Next
			oCopyFile.Copy (sDestFilePath & "\" & sFile)
			If Err.Number = 0 Then
				'wscript.echo "File copied: "  & sSourceFilePath & "\" & sFile
			Else
				'** Fejl i kopiering, log fejl *****************************
				wscript.echo "ERROR " & Err.Number & " copy file: " & sSourceFilePath & "\" & sFile
			End If
			On Error Goto 0

		End If
		Set oCopyFile = nothing
		Set oCopyFileDest = nothing
	Else

		'** Destination findes ikke, kopier fil ************************************
		Set oCopyFile = oFileSystem.GetFile(sSourceFilePath & "\" & sFile)
		CreateFolderTree(sDestFilePath)
		On Error resume Next
		oCopyFile.Copy (sDestFilePath & "\" & sFile)

		'** Slet kilde fil, hvis kopiering gik godt ********************************
		If Err.Number = 0 Then
			'wscript.echo "File copied: "  & sSourceFilePath & "\" & sFile
		Else
			'** Fejl i kopiering, log fejl *************************************
			wscript.echo  "Error " & Err.Number & " copy file: " & sSourceFilePath & "\" & sFile

		End If
		On Error Goto 0
		Set oCopyFile = nothing
	End If
	Set oFileSystem = nothing
End Function


'****************************************************************************** 
Function CreateFolderTree(strInput)
	Dim objFileSystemObject
	Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
	If Not objFileSystemObject.FolderExists(strInput) Then 
		Dim arrFolderPath,intFolder,strFolderTree
		arrFolderPath = Split(strInput,"\")
		For intFolder = 0 To UBound(arrFolderPath)
			strFolderTree = strFolderTree & arrFolderPath(intFolder) & "\"
			If intFolder > 1 Then 
				If Not objFileSystemObject.FolderExists(strFolderTree) Then
					objFileSystemObject.CreateFolder(strFolderTree)
				End If
			End If
		Next
		CreateFolderTree = True
	Else
		CreateFolderTree = False
	End If
	Set objFileSystemObject = nothing
End Function

Create OU Based Collections

I recently set up a whole new SCCM 2012 environment and we needed to create collections for a lot of OUs containing the computers.The script below will run through an OU structure and create device collections for each OU and sub OU’s.

To run the script open your SCCM console and press the drop down menu next to the home button and choose “Connect via Windows Powershell”.

This will establish a connection to the SCCM and allow you to use some special CM powershell functions which is utilized in this script.

To avoid warnings about the script not  being digitally signed run this command prior to executing the script it self.

Set-ExecutionPolicy -Scope Process -ExecutionPolicy Bypass

Now you can run the script.

It takes 1 mandatory argument and 3 optional which if not specified will default to the values they have in the script.

The mandatory argument is the SearchBase which is the top level OU from which you want to create the OU based Collections. The Optional arguments are LimitingCollection, SearchScope and RefreshType.

To run the script in its most simple form:

New-OUDeviceCollection.ps1 -SearchBase “OU=Computers,OU=Company,DC=OMG,DC=local”

This will create a collection for each of the OU’s under omg.local\Company\Computers – excluding the Computers container it self.

New-OUDeviceCollection.ps1 -SearchBase “OU=Computers,OU=Company,DC=OMG,DC=local” -LimitingCollection “All Windows 10 Computers” -SearchScope Subtree -RefreshType 2

This will create a collection for each of the OU’s under omg.local\Company\Computers – including the Computers container it self. It will use “All Windows 10 Computers” as the limiting Collection and it will use periodic update.

# Name: New-OUDeviceCollection
# Arguments: 4 (1 Mandatory, 3 Optional)
# 1. SearchBase (String, Mandatory): The top level OU from where you want to create OU Collections. The DistinguisedName attribute of the OU from AD is used.
# 2. LimitingCollection (String, Optional): The Collection to limit the new collections to. Default: All Desktop and Server Clients
# 3. SearchScope (String, Optional): Subtree, OneLevel or Base. Default: OneLevel
# 4. RefreshType (String, Optional): 1 (Manual),2 (Periodic), 4(CONSTANT_UPDATE) - Default: 4
#
# Description: This script will run through an OU and create device collections for each OU and sub OU's
# depending on what you specify in SearchScope.
param(
[string]$SearchBase,
[string]$LimitingCollection = 'All Desktop and Server Clients',
[string]$SearchScope = 'OneLevel',
[string]$RefreshType = '4'
)
$OUS = Get-ADOrganizationalUnit -SearchBase $SearchBase -SearchScope $SearchScope -Filter * -Properties Canonicalname
foreach ($OU in $OUS)
{
$OUName=$OU.Name
$Canonical=$OU.CanonicalName
New-CMDeviceCollection -Name "$OUName" -LimitingCollectionName $LimitingCollection -RefreshType $RefreshType
Add-CMDeviceCollectionQueryMembershipRule -CollectionName "$OUName" -QueryExpression "select SMS_R_SYSTEM.ResourceID, SMS_R_SYSTEM.ResourceType,
SMS_R_SYSTEM.Name,SMS_R_SYSTEM.SMSUniqueIdentifier,SMS_R_SYSTEM.ResourceDomainORWorkgroup,SMS_R_SYSTEM.Client from SMS_R_System where SMS_R_System.SystemOUName
= '$Canonical'" -RuleName "$OUName OU"
}
# Name: New-OUDeviceCollection # Arguments: 4 (1 Mandatory, 3 Optional) # 1. SearchBase (String, Mandatory): The top level OU from where you want to create OU Collections. The DistinguisedName attribute of the OU from AD is used. # 2. LimitingCollection (String, Optional): The Collection to limit the new collections to. Default: All Desktop and Server Clients # 3. SearchScope (String, Optional): Subtree, OneLevel or Base. Default: OneLevel # 4. RefreshType (String, Optional): 1 (Manual),2 (Periodic), 4(CONSTANT_UPDATE) - Default: 4 # # Description: This script will run through an OU and create device collections for each OU and sub OU's # depending on what you specify in SearchScope. param( [string]$SearchBase, [string]$LimitingCollection = 'All Desktop and Server Clients', [string]$SearchScope = 'OneLevel', [string]$RefreshType = '4' ) $OUS = Get-ADOrganizationalUnit -SearchBase $SearchBase -SearchScope $SearchScope -Filter * -Properties Canonicalname foreach ($OU in $OUS) { $OUName=$OU.Name $Canonical=$OU.CanonicalName New-CMDeviceCollection -Name "$OUName" -LimitingCollectionName $LimitingCollection -RefreshType $RefreshType Add-CMDeviceCollectionQueryMembershipRule -CollectionName "$OUName" -QueryExpression "select SMS_R_SYSTEM.ResourceID, SMS_R_SYSTEM.ResourceType, SMS_R_SYSTEM.Name,SMS_R_SYSTEM.SMSUniqueIdentifier,SMS_R_SYSTEM.ResourceDomainORWorkgroup,SMS_R_SYSTEM.Client from SMS_R_System where SMS_R_System.SystemOUName = '$Canonical'" -RuleName "$OUName OU" }
# Name: New-OUDeviceCollection
# Arguments: 4 (1 Mandatory, 3 Optional)
#   1. SearchBase (String, Mandatory): The top level OU from where you want to create OU Collections. The DistinguisedName attribute of the OU from AD is used.
#   2. LimitingCollection (String, Optional): The Collection to limit the new collections to. Default: All Desktop and Server Clients
#   3. SearchScope (String, Optional): Subtree, OneLevel or Base. Default: OneLevel
#   4. RefreshType (String, Optional): 1 (Manual),2 (Periodic), 4(CONSTANT_UPDATE) - Default: 4
#
# Description: This script will run through an OU and create device collections for each OU and sub OU's 
#              depending on what you specify in SearchScope.


param(
[string]$SearchBase,
[string]$LimitingCollection = 'All Desktop and Server Clients',
[string]$SearchScope = 'OneLevel',
[string]$RefreshType = '4'
)


$OUS = Get-ADOrganizationalUnit -SearchBase $SearchBase -SearchScope $SearchScope -Filter * -Properties Canonicalname
foreach ($OU in $OUS) 
 {
    $OUName=$OU.Name
    $Canonical=$OU.CanonicalName
    New-CMDeviceCollection -Name "$OUName" -LimitingCollectionName $LimitingCollection -RefreshType $RefreshType
    Add-CMDeviceCollectionQueryMembershipRule -CollectionName "$OUName" -QueryExpression "select SMS_R_SYSTEM.ResourceID, SMS_R_SYSTEM.ResourceType,
    SMS_R_SYSTEM.Name,SMS_R_SYSTEM.SMSUniqueIdentifier,SMS_R_SYSTEM.ResourceDomainORWorkgroup,SMS_R_SYSTEM.Client from SMS_R_System where SMS_R_System.SystemOUName
   = '$Canonical'" -RuleName "$OUName OU"
 }