Infopath based loginscript

I've built a solution where our IT department can manage the network- and printer connections for our users with the help of Infopath and a loginscript.

I simply believe that some people prefer to fill in forms rather than editing xml-files or modifying source code. If you agree with me, please read on.

With the help of one Infopath form per department within our company, each user gets the correct printers and paths, depending on which organizational unit of the Active Directory the user belongs to.

The UI of the Infopath form looks like this:


Each section which contains rows are repeating so that the IT-guy can add and remove rows as he or she sees fit. Notice the checkboxes which are used as parameters in the vbscript code. Technically, Infopath forms are just xml-files. Because of this, it is easy to read the xml from the loginscript written in vbscript.

To create your own solution like this, simply create a form with Infopath which has a data source something like below.

The data source of the form should perhaps look like this:


You can read more about Infopath on the Infopath blog

Now, study the vbscript below and use it to point to your form. Verify that your namespaces match the ones in the script. Modify if necessary.

In the vbscript function GetDepartmentXMLPath below you would implement your own code to set the path to the Infopath form. I am using the Distinguished name to break out and determine the OU structure and then concatenating the string to point to the xml-file for the correct department. How you do it is completely up to you. The important thing is that it returns the path to a xml file with the proper elements.

Here is my vbscript which uses the Infopath form:


Option Explicit

' Remove network drives specified in Infopath form
RemoveNetworkDrives()

' Add network drives specified in Infopath form
MapNetworkDrives()

' Add printers
AddPrinters()

' Remove old printers
RemovePrinters()


Function GetDepartmentXMLPath()
On Error Resume Next

Dim strSite
Dim strDepartment
Dim sXMLLoad
Dim sXmlFilePath
Dim sDistinguishedName

' This is how you could create a unique filename for a user in Active Directory
' depending on where he/she is located. You would have to implement custom functions
' to get Site and department values.
' -----------------------------------
'sDistinguishedName = GetCurrentUsersDistinguishedName()
'strSite = GetSite(sDistinguishedName)
'strDepartment = GetDepartment(sDistinguishedName)
'sXMLLoad = sXmlFilePath & strSite & "." & strDepartment & ".xml"
'MsgBox "File to read xml from: " & sXMLLoad, 64, "XML"
' -----------------------------------

' For now, just set a path to where your Infopath file is saved.
' In my case, this is the following path.
' ---------------------------------------------
' CHANGE THIS PATH!
' ---------------------------------------------
sXmlFilePath = "\\server\sysvol\server\scripts\InfoPath\"

' Let's call the form Settings.xml
sXMLLoad = sXmlFilePath & "Settings.xml"

' Return path and filename for the form which is active for this user.
GetDepartmentXMLPath = sXMLLoad
End Function


Sub RemoveNetworkDrives()
On Error Resume Next

Dim xmlDoc
Dim elDrives
Dim sLetter
Dim sForce
Dim sUpdateProfile
Dim nodeDrive

Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Load(GetDepartmentXMLPath())

Set elDrives = xmlDoc.getElementsByTagName("my:RemoveDrives")
For Each nodeDrive in elDrives.item(0).childNodes
sLetter = nodeDrive.childNodes(0).text
sForce = nodeDrive.childNodes(1).text
sUpdateProfile = nodeDrive.childNodes(2).text

If sLetter <> "" Then
RemoveNetworkDrive sLetter, sForce, sUpdateProfile
'MsgBox "Letter:" & sLetter & ", Force: " & sForce & _
'", Update Profile: " & sUpdateProfile,64, Removed Drive"
End If
Next

Set elDrives = Nothing
Set xmlDoc = Nothing
End Sub


Sub RemoveNetworkDrive(sLetter, sForce, sUpdateProfile)
On Error Resume Next

Dim objNet
Dim sDrive
Dim bIsPresent

Set objNet = CreateObject("WScript.Network")

' See if the drive is already in use
For Each sDrive In objNet.enumNetworkDrives
If LCase(sDrive) = LCase(sLetter) Then
bIsPresent = True
End If
Next

' Remove the Drive if it is present
If bIsPresent Then
objNet.RemoveNetworkDrive sLetter, sForce, sUpdateProfile
If err <> 0 Then
'MsgBox "Failed to remove " & sLetter,vbExclamation, "Alert"
err.Clear
End If
End If

Set objNet = Nothing
End Sub


Sub MapNetworkDrives()
On Error Resume Next

Dim xmlDoc
Dim elDrives
Dim sLetter
Dim sNetshare
Dim sReConnect
Dim nodeDrive

Set xmlDoc = CreateObject("Microsoft.XMLDOM")

xmlDoc.Load(GetDepartmentXMLPath())
Set elDrives = xmlDoc.getElementsByTagName("ns1:Drives")

For Each nodeDrive in elDrives.item(0).childNodes
sLetter = nodeDrive.childNodes(0).text
sNetshare = nodeDrive.childNodes(1).text
sReConnect = nodeDrive.childNodes(2).text

If sLetter <> "" Then
AddNetworkDrive sLetter, sNetshare, sReConnect
'MsgBox "Letter:" & sLetter & ", Netshare: " & _
'sNetshare & ", reconnect: " & sReConnect,64, "Mapped Drive"
End If
Next

Set elDrives = Nothing
Set xmlDoc = Nothing
End Sub


Sub AddNetworkDrive(sLetter, sNetshare, sReConnect)
On Error Resume Next

Dim objNet
Dim sDrive
Dim bIsPresent

Set objNet = CreateObject("WScript.Network")

' See if the drive is already in use
For Each sDrive In objNet.enumNetworkDrives
If LCase(sDrive) = LCase(sLetter) Then
bIsPresent = True
End If
Next

' Map the Drive if it is not already present
If Not bIsPresent Then
If Not sNetshare = "" Then
objNet.MapNetworkDrive sLetter, sNetshare, sReConnect
If err <> 0 Then
'MsgBox "Failed to map " & sLetter & " to " & sNetshare,vbExclamation, "Alert"
err.Clear
End If
End If
End If

Set objNet = Nothing
End Sub


Sub AddPrinters()
On Error Resume Next

Dim objNet
Dim xmlDoc
Dim elPrinterInfo
Dim xmlFilePath
Dim nodePrinter
Dim sPrinterServer
Dim sPrinterName
Dim sDefault
Dim item
Dim printer

Set objNet = CreateObject("WScript.Network")
Set xmlDoc = CreateObject("Microsoft.XMLDOM")

xmlDoc.Load(GetDepartmentXMLPath())

Set elPrinterInfo = xmlDoc.getElementsByTagName("ns1:Printers")

For Each nodePrinter in elPrinterInfo.Item(0).childnodes
sPrinterServer = nodePrinter.childnodes.item(0).text
sPrinterName = nodePrinter.childnodes.item(1).text
sDefault = nodePrinter.childnodes.item(2).text

If Not sPrinterName = "" Then
objNet.AddWindowsPrinterConnection sPrinterServer & sPrinterName
'MsgBox "PrinterServer: " & sPrinterServer & ", PrinterName: " & _
' sPrinterName & ", Default:" & sDefault,64, "Printers"
If err = 0 Then
' Succeeded
If (sDefault = "true") Then
objNet.SetDefaultPrinter sPrinterServer & sPrinterName
End If
Else
err.Clear()
End If
End If
Next

Set xmlDoc = Nothing
Set elPrinterInfo = Nothing
Set objNet = Nothing
End Sub


Sub RemovePrinters()
On Error Resume Next

Dim objNet
Dim xmlDoc
Dim elPrinterInfo
Dim nodePrinter
Dim sPrinterName
Dim sForce
Dim sUpdateProfile

Set objNet = CreateObject("WScript.Network")
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Load(GetDepartmentXMLPath())

Set elPrinterInfo = xmlDoc.getElementsByTagName("my:RemovePrinters")
For Each nodePrinter in elPrinterInfo.Item(0).childnodes
sPrinterName = nodePrinter.childnodes.item(0).text
sForce = nodePrinter.childnodes.item(1).text
sUpdateProfile = nodePrinter.childnodes.item(2).text

If Not sPrinterName = "" Then
objNet.RemovePrinterConnection sPrinterName, sForce, sUpdateProfile
'MsgBox "Printername to remove: " & sPrinterName & ", force: " & sForce & _
' ", update profile:" & sUpdateProfile,64, "Remove Printers"
End If
Next

Set xmlDoc = Nothing
Set elPrinterInfo = Nothing
Set objNet = Nothing
End Sub




That made sense didn't it? At least it works like a charm for our It-department.