Script for Bulk Import of Active Directory Subnets

I’ve been using this script for years now and was reminded of it by a post on the activedir.org DL the other day. The script does exactly what the name implies – it takes a tab separated input file (supplied as the first argument) and generates Active Directory subnet objects for each line. If the subnet already exists, the associated site and description will be updated. The script targets the forest the user is currently logged in to.

The code is pasted in below, note the format for the input file (TSV). One field I noticed is missing is the canonical location field. You should be able to add this to the script pretty easily if you need this, or if there’s sufficient demand leave a comment and I can do it.

'==========================================================================
' NAME: Import Subnets from Tab Seperated File
'
' AUTHOR: Brian Desmond, brian@briandesmond.com
'
' COMMENT: 
'
' TEMPLATE FILE FORMAT (tab delimited):
' Subnet Address	Prefix Length	Site Name	Description
'==========================================================================

Option Explicit

If WScript.Arguments.Count < 1 Then
	WScript.Echo "Specify an input file name as an argument to this script."
	WScript.Quit(1)
End If 

Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")

Dim importFile
importFile = Trim(WScript.Arguments(0))

If Not fso.FileExists(importFile) Then
	WScript.Echo "Input file not found"
	WScript.Quit(1)
End If 

Dim configNcDn
configNcDn = GetConfigNc()

Dim inputReader
Set inputReader = fso.OpenTextFile(importFile)

Dim line
While Not inputReader.AtEndOfStream
	line = inputReader.ReadLine
	Dim tokens
	tokens = Split(line, vbtab)
	
	Dim subnetAddress
	subnetAddress = ""
	Dim prefixLength
	prefixLength = ""
	Dim siteName
	siteName = ""
	Dim description
	description = ""	
	
	On Error Resume Next
	
	subnetAddress = tokens(0)
	prefixLength = tokens(1)
	siteName = tokens(2)
	description = tokens(3)
	
	On Error GoTo 0 
	
	If subnetAddress = "" Or prefixLength = "" Or siteName = "" Then
		WScript.Echo "FAIL: " & line
	Else
		Dim siteDn
		siteDn = GetSiteDn(configNcDn, siteName)
		
		If siteDn = "" Then 
			WScript.Echo "SITE NOT FOUND: " & line 
		Else
			Dim subnetCn
			subnetCn = subnetAddress & "/" & prefixLength
		
			'On Error Resume Next 
			Dim subnetDn
			subnetDn = ""
			subnetDn = GetSubnetDn(configNcDn, subnetCn)
			WScript.Echo subnetDn 
			Dim subnetExists		
			If subnetDn = "" Then
				subnetExists = False
			Else
				subnetExists = True 
			End If 
			
			'Err.Clear 
			'On Error GoTo 0 
			
			Dim subnetObj
			If subnetExists Then 
				WScript.Echo subnetDn 
				Set subnetObj = GetObject("LDAP://" & Replace(subnetDn, "/", "\/"))
			Else 
				Dim configObj
				Set configObj = GetObject("LDAP://CN=Subnets,CN=Sites," & configNcDn)
				
				Set subnetObj = configObj.Create("subnet", "cn=" & subnetCn)
			End If 			

			subnetObj.Put "siteObject", siteDn
			If Not Trim(description) = "" Then 
				subnetObj.Put "description", description
			End If 
			subnetObj.SetInfo 
				
			WScript.Echo "SUCCEED: " & line 
			Set subnetObj = Nothing 
		End If 
	End If 
Wend

inputReader.Close
WScript.Echo "Complete"

Function GetConfigNc()
	Dim rootDse
	Set rootDse = GetObject("LDAP://RootDSE")
	
	Dim configNc
	configNc = rootDse.get("configurationNamingContext")
	
	Set rootDse = Nothing
	
	GetConfigNc = configNc
End Function

Function GetSiteDn(configNc, siteName)
	Dim cnxn
	Set cnxn = WScript.CreateObject("ADODB.Connection")
	cnxn.Provider = "ADsDSOObject"
	cnxn.Open "Active Directory Provider"
	
	Dim cmd
	Set cmd = WScript.CreateObject("ADODB.Command")
	cmd.ActiveConnection = cnxn
	
	cmd.CommandText = "<LDAP://" & configNc & ">;(&(objectcategory=site)(cn=" & siteName & "));distinguishedName;subtree"
	cmd.Properties("Page Size") = 100
	cmd.Properties("Timeout") = 30
	cmd.Properties("Cache Results") = False
	
	Dim rs
	Set rs = cmd.Execute
	
	While Not rs.eof 
		GetSiteDn = rs.fields("distinguishedName").Value
		
		rs.MoveNext
	Wend 
	
	rs.close
	cnxn.Close
	
	Set rs = Nothing
	Set cmd = Nothing
	Set cnxn = Nothing 
End Function 

Function GetSubnetDn(configNc, subnetName)
	Dim cnxn
	Set cnxn = WScript.CreateObject("ADODB.Connection")
	cnxn.Provider = "ADsDSOObject"
	cnxn.Open "Active Directory Provider"
	
	Dim cmd
	Set cmd = WScript.CreateObject("ADODB.Command")
	cmd.ActiveConnection = cnxn
	
	cmd.CommandText = "<LDAP://" & configNc & ">;(&(objectcategory=subnet)(cn=" & subnetName & "));distinguishedName;subtree"
	cmd.Properties("Page Size") = 100
	cmd.Properties("Timeout") = 30
	cmd.Properties("Cache Results") = False
	
	Dim rs
	Set rs = cmd.Execute
	
	While Not rs.eof 
		GetSubnetDn = rs.fields("distinguishedName").Value
		
		rs.MoveNext
	Wend 
	
	rs.close
	cnxn.Close
	
	Set rs = Nothing
	Set cmd = Nothing
	Set cnxn = Nothing 
End Function