VBscript map drives based on AD groups. How to add support for nested groups?

Option Explicit
 
'Set up variables, objects and constants.
 
Dim oNet, oFSO, oShell, UserName, LogPath, LogFile, objGroupList
Dim MapDrivesLog, MapDrivesLogObj, DriveObj, TristateFalse
 
Set oNet   = CreateObject("Wscript.Network")
set oFSO   = CreateObject("Scripting.FileSystemObject")
Set oShell = WScript.CreateObject("Shell.Application")
 
Const ForReading = 1, ForWriting = 2, ForAppending = 8
 
LogPath = "C:\Windows\LogFiles\"
LogFile = "MapDrives.log"
 
'***************************************************************
 
'Finds username of user logging in.
 
UserName = ""
on error resume next
While UserName = ""
      UserName = LCASE(oNet.UserName)
on error resume next
WEnd
 
'***************************************************************
 
'Checks that the log directory exists, if not create directory.
 
If oFSO.FolderExists(LogPath) = False then oFSO.CreateFolder(LogPath)
 
'Create log of events. Check that the log doesn't get too big
 
If oFSO.FileExists (LogPath & LogFile) = True Then
  Set MapDrivesLogObj = oFSO.GetFile(LogPath & LogFile)
  If MapDrivesLogObj.size > 128000 Then oFSO.DeleteFile(LogPath & LogFile)
    Else
End If
 
'Appends events to log.
 
Set MapDrivesLog = oFSO.OpenTextFile ((LogPath & LogFile), ForAppending, True, TristateFalse)
 
'***************************************************************
 
'Calls sub to create and open log file. Writes event and user specific details to log.
 
OpenLogFile()
 
'***************************************************************
 
'Map common drives before checking for special drive mappings.
 
CommonDriveMapping()
 
'***************************************************************
 
'Writes to log file.
 
MapDrivesLog.WriteLine
MapDrivesLog.WriteLine("User Specific Drives")
MapDrivesLog.WriteLine
 
'***************************************************************
    
'Checks user for special drive mappings. If user not listed below, calls sub that 
'maps drives based on groups. Add new users and drive mappings below when needed.
 
Select Case UserName
  CASE "user1"
    MapDrive "V:", "\\Server\Communications", "Communications" 
    MapDrive "W:", "\\Server\Development", "Development"
  CASE "user2"
    MapDrive "V:", "\\Server\Registrar", "Registrar"
    MapDrive "W:", "\\Server\Headmaster", "Headmaster"
  CASE "user3"
    MapDrive "V:", "\\Server\Registrar", "Registrar"
    MapDrive "W:", "\\Server\Headmaster", "Headmaster"
  CASE ELSE
    GroupDriveMapping()
End Select
 
'***************************************************************
 
' Writes to log file.
 
MapDrivesLog.WriteLine
MapDrivesLog.WriteLine("User Backup Drive")
MapDrivesLog.WriteLine
 
'***************************************************************
 
' Calls sub to rename users' Backup drive.
 
RenameBackupDrive()
 
'***************************************************************
  
' Writes to log file. Closes log and ends script.
 
MapDrivesLog.WriteLine
MapDrivesLog.WriteLine "Script completed successfully!"
MapDrivesLog.WriteLine
MapDrivesLog.close
wscript.quit
 
'***************************************************************
'***************************************************************
 
' Functions and Sub Routines
 
 
'Finds out what groups the user is a member of.
 
Function IsMember(ByVal strGroup)
    ' Function to test for group membership.
    ' strGroup is the NT name (sAMAccountName) of the group to test.
    ' objGroupList is a dictionary object, with global scope.
    ' Returns True if the user or computer is a member of the group.
 
    If (IsEmpty(objGroupList) = True) Then
        Set objGroupList = CreateObject("Scripting.Dictionary")
        Call LoadGroups(objADObject)
    End If
    IsMember = objGroupList.Exists(strGroup)
End Function
 
Sub LoadGroups(ByVal objADObject)
    ' Recursive subroutine to populate dictionary object with group
    ' memberships. When this subroutine is first called by Function
    ' IsMember, objADObject is the user or computer object. On recursive calls
    ' objADObject will be a group object. For each group in the MemberOf
    ' collection, first check to see if the group is already in the
    ' dictionary object. If it is not, add the group to the dictionary
    ' object and recursively call this subroutine again to enumerate any
    ' groups the group might be a member of (nested groups). It is necessary
    ' to first check if the group is already in the dictionary object to
    ' prevent an infinite loop if the group nesting is "circular".
 
    Dim colstrGroups, objGroup, j
    objGroupList.CompareMode = vbTextCompare
    colstrGroups = objADObject.memberOf
    If (IsEmpty(colstrGroups) = True) Then
        Exit Sub
    End If
    If (TypeName(colstrGroups) = "String") Then
        ' Escape any forward slash characters, "/", with the backslash
        ' escape character. All other characters that should be escaped are.
        colstrGroups = Replace(colstrGroups, "/", "\/")
        Set objGroup = GetObject("LDAP://" & colstrGroups)
        If (objGroupList.Exists(objGroup.sAMAccountName) = False) Then
            objGroupList.Add objGroup.sAMAccountName, True
            Call LoadGroups(objGroup)
        End If
        Set objGroup = Nothing
        Exit Sub
    End If
    For j = 0 To UBound(colstrGroups)
        ' Escape any forward slash characters, "/", with the backslash
        ' escape character. All other characters that should be escaped are.
        colstrGroups(j) = Replace(colstrGroups(j), "/", "\/")
        Set objGroup = GetObject("LDAP://" & colstrGroups(j))
        If (objGroupList.Exists(objGroup.sAMAccountName) = False) Then
            objGroupList.Add objGroup.sAMAccountName, True
            Call LoadGroups(objGroup)
        End If
    Next
    Set objGroup = Nothing
End Sub
 
 
'Removes old drive mappings, then maps drives if the share is valid.
 
Sub MapDrive(Drive, UNC, NewName)
 
  If oFSO.FolderExists(UNC) = True Then          
    If oFSO.DriveExists(Drive) = True Then
      Set DriveObj = oFSO.GetDrive(Drive)              
      oNet.RemoveNetworkDrive Drive
    End If
      oNet.MapNetworkDrive Drive, UNC
      oShell.NameSpace(Drive).Self.Name = (NewName)
      MapDrivesLog.WriteLine("Success... MAPPED " & Drive & " to " & NewName)
    Else
      MapDrivesLog.WriteLine("FAILURE!!! UNABLE to map " & Drive & " t: " & NewName)
      MapDrivesLog.WriteLine("The drive path does not exist or is unavailable.")
  End If
  
End Sub
 
 
'Creates and opens log file. Writes event and user specific details to log.
 
Sub OpenLogFile()
 
  MapDrivesLog.WriteLine("===========================================")
  MapDrivesLog.WriteLine(Date & " " & Time)
  MapDrivesLog.WriteBlankLines(1)
  MapDrivesLog.WriteLine("Computer: " & oNet.ComputerName)
  MapDrivesLog.WriteLine("Username: " & oNet.UserName)
  
End Sub
 
 
'Maps Common drives.
 
Sub CommonDriveMapping
 
MapDrivesLog.WriteLine
MapDrivesLog.WriteLine("User Common Drives")
MapDrivesLog.WriteLine
 
  If IsMember("Staff") Then
    MapDrive "Q:", "\\Server\FacStaff", "FacStaff"    
    MapDrive "R:", "\\Server\Common", "Common"    
    MapDrive "S:", "\\Server\Install", "Install"
    MapDrive "T:", "\\Server\Transfer", "Transfer"
  End If
  
  If IsMember("Faculty") Then
    MapDrive "Q:", "\\Server\FacStaff", "FacStaff"    
    MapDrive "R:", "\\Server\Common", "Common"    
    MapDrive "S:", "\\Server\Install", "Install"
    MapDrive "T:", "\\Server\Transfer", "Transfer"
  End If
 
  If IsMember("Students") Then 
    MapDrive "R:", "\\Server\Common", "Common"    
    MapDrive "S:", "\\Server\Install", "Install"
    MapDrive "T:", "\\Server\Transfer", "Transfer"
  End If
  
End Sub
 
 
'Maps drives based on AD group membership. Add new groups and drive mappings below when needed.
 
Sub GroupDriveMapping
 
  If IsMember("AdmissionOffice") Then 
    MapDrive "W:", "\\Server\Admission", "Admission"
  End If
 
  If IsMember("Alumni-Development") Then
    MapDrive "W:", "\\Server\Development", "Development"
  End If
 
  If IsMember("Aphoto") Then
    MapDrive "X:", "\\Server\photo", "photo"
  End If
 
  If IsMember("Arts") Then
    MapDrive "W:", "\\Server\arts", "Arts"
  End If
 
  If IsMember("Athletics") Then
    MapDrive "W:", "\\Server\Athletics", "Athletics"
  End If
 
  If IsMember("BuildingServices") Then
    MapDrive "X:", "\\Server\Insurance", "Insurance"
    MapDrive "W:", "\\Server\BuildingServices", "Building Services"
  End If
 
  If IsMember("BoilerRoom") Then
    MapDrive "X:", "\\Server\Energy", "Energy"
    MapDrive "W:", "\\Server\BuildingServices", "Building Services"
  End If
 
  If IsMember("Bookstore") Then
    MapDrive "W:", "\\Server\bookstore", "Bookstore"
  End If
 
  If IsMember("BOPayroll") Then
    MapDrive "V:", "\\Server\Payroll", "Payroll"
    
  End If
  If IsMember("BusinessOffice") Then
    MapDrive "W:", "\\Server\Common", "Common"
  End If
 
  If IsMember("CollegeOffice") Then
    MapDrive "W:", "\\Server\College", "College"
  End If
 
  If IsMember("Communications") Then
    MapDrive "V:", "\\Server\News", "News"
    MapDrive "W:", "\\Server\Communications", "Communications"
  End If
 
  If IsMember("DeansOffice") Then
    MapDrive "V:", "\\Server\Registrar", "Registrar"
    MapDrive "W:", "\\Server\DeansOffice", "Deans Office"
  End If
 
  If IsMember("Energy") Then
    MapDrive "N:", "\\Server\Energy", "Energy"
  End If
 
  If IsMember("FoodService") Then
    MapDrive "W:", "\\Server\foodService", "Food Service"
  End If
 
  If IsMember("HeadmastersOffice") Then
    MapDrive "W:", "\\Server\Headmaster", "Headmaster"
  End If
 
  If IsMember("HealthCenterGroup") Then
    MapDrive "O:", "\\Server\InjuryDB", "Injury Database"
    MapDrive "W:", "\\Server\HealthCenter", "Health Center"
  End If
  
  If IsMember("Insurance") Then
    MapDrive "Y:", "\\Server\Insurance", "Insurance"
  End If
  
  If IsMember("Maintenance") Then
    MapDrive "W:", "\\Server\BuildingServices", "Building Services"
  End If
  
  If IsMember("Podcast") Then
    MapDrive "P:", "\\Server\Podcast", "Podcast"
  End If
 
  If IsMember("AuctionGroup") Then
    MapDrive "V:", "\\Server\Auction", "Auction"
  End If
  
  If IsMember("RegistrarsOffice") Then
    MapDrive "W:", "\\Server\Registrar", "Registrar"
  End If
 
  If IsMember("SecurityGroup") Then
    MapDrive "W:", "\\Server\Security", "Security"
  End If
 
  If IsMember("StudentServices") Then
    MapDrive "W:", "\\Server\StudentServices", "Student Services"
  End If
 
  If IsMember("TechTeam") Then
    MapDrive "W:", "\\Server\Tech", "Technology"
  End If
 
  If IsMember("Yearbook") Then
    MapDrive "W:", "\\Server\Yearbook", "Yearbook"
  End If
 
End Sub
 
 
'Renames user backup drive.
 
Sub RenameBackupDrive
 
  If oFSO.DriveExists("U:") = True Then          
     oShell.NameSpace("U:").Self.Name = UserName & "'s Backup"
     MapDrivesLog.WriteLine("Success... Renamed U: to " & UserName & "'s Backup")
    Else
     MapDrivesLog.WriteLine("FAILURE!!! UNABLE to rename U: to " & UserName & "'s Backup")
     MapDrivesLog.WriteLine("The drive does not exist.")
  End If
  
End Sub
 
'***************************************************************
'***************************************************************

Select allOpen in new window