Loginscript map drives thru group membership with recursive check

[Noffe]

Hi all

I have used a login script that maps drives depending on group membership but my problem is that it doesn’t do a recursive check so if they are members of a nested group they don’t get correct drive mappings.
I used another script to export nested group membership for all groups in a certain OU.
But I don’t know how to combine the scripts so if anyone can help me with that I grateful.

This is the current code I use:

Option Explicit

Dim WSHNetwork, DomainString, UserString
Dim UserObj, GroupObj, FSO


Set WSHNetwork = CreateObject("WScript.Network")
DomainString = WSHNetwork.UserDomain
UserString = WSHNetwork.UserName
Set UserObj = GetObject("WinNT://" & DomainString & "/" & UserString)

' Map drives thru depending on group membership 
For Each GroupObj In UserObj.Groups
    Select Case GroupObj.Name

        Case "Domain Users"
			On Error Resume Next
				WSHNetwork.MapNetworkDrive "G:", "\\SRV018.mydomain.local\Common"
				WSHNetwork.MapNetworkDrive "H:", "\\srv018.mydomain.local\hemkat$\" & WSHNetwork.Username & ""
			If Err.Number <> 0 Then
				WSHNetwork.RemoveNetworkDrive "G:", True, True
				WSHNetwork.RemoveNetworkDrive "H:", True, True
				WSHNetwork.MapNetworkDrive "G:", "\\SRV018.mydomain.local\Common"
				WSHNetwork.MapNetworkDrive "H:", "\\srv018.mydomain.local\hemkat$\" & WSHNetwork.Username & ""
			End If
			On Error GoTo 0

        Case "IT Support"
			On Error Resume Next
				WSHNetwork.MapNetworkDrive "I:", "\\SRV018.mydomain.local\IT Systems"
			If Err.Number <> 0 Then
				WSHNetwork.RemoveNetworkDrive "I:", True, True
				WSHNetwork.MapNetworkDrive "I:", "\\SRV018.mydomain.local\IT Systems"
			End If
			On Error GoTo 0
        
        Case "Ekonomi"
			On Error Resume Next
				WSHNetwork.MapNetworkDrive "J:", "\\SRV018.mydomain.local\FINANCE"
			If Err.Number <> 0 Then
				WSHNetwork.RemoveNetworkDrive "J:", True, True
				WSHNetwork.MapNetworkDrive "J:", "\\SRV018.mydomain.local\FINANCE"
			End If
			On Error GoTo 0
        
        Case "SaleDb"
			On Error Resume Next
				WSHNetwork.MapNetworkDrive "K:", "\\SRV018.mydomain.local\SALEDB"
			If Err.Number <> 0 Then
				WSHNetwork.RemoveNetworkDrive "K:", True, True
				WSHNetwork.MapNetworkDrive "K:", "\\SRV018.mydomain.local\SALEDB"
			End If
			On Error GoTo 0
        
        Case "Ledningsgruppen"
			On Error Resume Next
				WSHNetwork.MapNetworkDrive "L:", "\\SRV018.mydomain.local\Management"
			If Err.Number <> 0 Then
				WSHNetwork.RemoveNetworkDrive "L:", True, True
				WSHNetwork.MapNetworkDrive "L:", "\\SRV018.mydomain.local\Management"
			End If
			On Error GoTo 0
        
        Case "Market"
			On Error Resume Next
				WSHNetwork.MapNetworkDrive "M:", "\\SRV018.mydomain.local\MARKET"
			If Err.Number <> 0 Then
				WSHNetwork.RemoveNetworkDrive "M:", True, True
				WSHNetwork.MapNetworkDrive "M:", "\\SRV018.mydomain.local\MARKET"
			End If
			On Error GoTo 0
        
        Case "Affarsutveckling"
			On Error Resume Next
				WSHNetwork.MapNetworkDrive "N:", "\\SRV018.mydomain.local\Affarsutveckling"
			If Err.Number <> 0 Then
				WSHNetwork.RemoveNetworkDrive "N:", True, True
				WSHNetwork.MapNetworkDrive "N:", "\\SRV018.mydomain.local\Affarsutveckling"
			End If
			On Error GoTo 0
        
        Case "Product Development"
			On Error Resume Next
				WSHNetwork.MapNetworkDrive "O:", "\\SRV018.mydomain.local\Product Development"
			If Err.Number <> 0 Then
				WSHNetwork.RemoveNetworkDrive "O:", True, True
				WSHNetwork.MapNetworkDrive "O:", "\\SRV018.mydomain.local\Product Development"
			End If
			On Error GoTo 0
        
        Case "Produkt"
			On Error Resume Next
				WSHNetwork.MapNetworkDrive "P:", "\\SRV018.mydomain.local\Produkt"
			If Err.Number <> 0 Then
				WSHNetwork.RemoveNetworkDrive "P:", True, True
				WSHNetwork.MapNetworkDrive "P:", "\\SRV018.mydomain.local\Produkt"
			End If
			On Error GoTo 0
        
        Case "Sweden Operation"
			On Error Resume Next
				WSHNetwork.MapNetworkDrive "Q:", "\\SRV018.mydomain.local\Sweden Operation"
			If Err.Number <> 0 Then
				WSHNetwork.RemoveNetworkDrive "Q:", True, True
				WSHNetwork.MapNetworkDrive "Q:", "\\SRV018.mydomain.local\Sweden Operation"
			End If
			On Error GoTo 0
        
        Case "Salj"
			On Error Resume Next
				WSHNetwork.MapNetworkDrive "S:", "\\SRV018.mydomain.local\SALES"
			If Err.Number <> 0 Then
				WSHNetwork.RemoveNetworkDrive "S:", True, True
				WSHNetwork.MapNetworkDrive "S:", "\\SRV018.mydomain.local\SALES"
			End If
			On Error GoTo 0
       
        Case "Domain Admins"
			On Error Resume Next
				WSHNetwork.MapNetworkDrive "W:", "\\SRV018.mydomain.local\nbaxess\AXESS"
			If Err.Number <> 0 Then
				WSHNetwork.RemoveNetworkDrive "W:", True, True
				WSHNetwork.MapNetworkDrive "W:", "\\SRV018.mydomain.local\nbaxess\AXESS"
			End If
			On Error GoTo 0
        
        Case "QlikViewUsers"
			On Error Resume Next
				WSHNetwork.MapNetworkDrive "X:", "\\SRV018.mydomain.local\Qlikview"
			If Err.Number <> 0 Then
				WSHNetwork.RemoveNetworkDrive "X:", True, True
				WSHNetwork.MapNetworkDrive "X:", "\\SRV018.mydomain.local\Qlikview"
			End If
			On Error GoTo 0
			
    End Select
Next

WScript.Quit

And here is is the code for exporting group membership

Option Explicit

Dim objMemberList, strOU, objOU, objConnection, objCommand, objFSO, objFile
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")

' Dictionary object to track groups.
Set objMemberList = CreateObject("Scripting.Dictionary")
objMemberList.CompareMode = vbTextCompare
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("Groups.csv", True)

' Specify base OU.
strOU = "ou=Groups,dc=Company,dc=mydomain,dc=local"

' Bind to base OU.
Set objOU = GetObject("LDAP://" & strOU)

' Enumerate groups in OU.
Call EnumOU(objOU, "")

Sub EnumOU(ByVal objADContainer, ByVal strOffset)
' Recursive subroutine to enumerate groups in the OU
' and all child OU's.

Dim objGroup, objChild

' Output name of OU.
objFile.Write strOffset & "OU: " & objADContainer.distinguishedName

' Enumerate groups in OU.
objADContainer.Filter = Array("group")
For Each objGroup In objADContainer
Call EnumGroup(objGroup, strOffset & " ")
Next

' Enumerate child OU's.
objADContainer.Filter = Array("organizationalUnit")
For Each objChild In objADContainer
Call EnumOU(objChild, strOffset & " ")
Next

End Sub

Sub EnumGroup(ByVal objADGroup, ByVal strOffset)
' Recursive subroutine to enumerate group membership.
' objMemberList is a dictionary object with global scope.
' This subroutine outputs group members. Nested group members
' are included. objMemberList prevents an infinite loop if
' nested groups are circular.

Dim objMember

' Check if group already enumerated.
If (objMemberList.Exists(objADGroup.sAMAccountName) = True) Then
objFile.Write  strOffset & "Group: " & objADGroup.sAMAccountName & "(Duplicate)"
Else
' Add this group to dictionary object.
objMemberList.Add objADGroup.sAMAccountName, True
objFile.Write  strOffset & "Group: " & objADGroup.sAMAccountName
For Each objMember In objADGroup.Members
' Check if member is a group.
If (UCase(Left(objMember.objectCategory, 8)) = "CN=GROUP") Then
objFile.Write  strOffset & " Member: " & objMember.sAMAccountName & " (Group)"
Call EnumGroup(objMember, strOffset & " ")
Else
objFile.Write  strOffset & " Member: " & objMember.sAMAccountName
End If
Next
End If

End Sub

objFile.Close

Thanks in advance.

 

[mrmovie]

my advice would be not to support drive mapping based on nested group membership.

 

[puko]

I hate to hijack the specific direction of the thread, and if there is some posting rules about it please let me know...(havnt seen any posting stickies about it yet)

but, when working with groups,
if this were a more basic drive mappin script,
with a more basic ad scheme,

would you need Noffe's "code for exporting group membership" portion of the script?

I'm in the middle of researching what exactly that portion does and why/if you must have it, I see it in some group scripts and sometimes I don't and was just wondering what it does.