Solved

VB script to get OU name and username

Posted on 2010-09-19
9
517 Views
Last Modified: 2012-05-10
Hi,

I have a windows 2008 DC and a file server that contains user folders.
I created shared common folders for each OU. Now when ever a user logs into domain his OU common folder should map as Z drive. How I can do this using VB script

teks
0
Comment
Question by:teksalah
  • 4
  • 3
  • 2
9 Comments
 
LVL 8

Expert Comment

by:spinzr0
ID: 33711487
I'm not sure of your folder structure so I left a variable at the top called server path which will be everything but the OU.  So it its \\server\folder1\OU then the path would be \\server\folder1.
sServerPath = "\\my server\folder1"

Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1

Set oWShell = CreateObject("WScript.Shell")
sUserName = oWShell.ExpandEnvironmentStrings("%username%")
sDomain = GetDomain()

Set oTranslate = CreateObject("NameTranslate")
oTranslate.Init ADS_NAME_INITTYPE_GC, sDomain
oTranslate.Set ADS_NAME_TYPE_NT4, sDomain & "\" & sUserName

Set oUser = GetObject("LDAP://" & oTranslate.Get(ADS_NAME_TYPE_1779))
sDN = oUser.distinguishedName
sOU = Mid(sDN, InStr(sDN, ",") + 4, InStr(InStr(sDN, ",") + 4, sDN, ",") - (InStr(sDN, ",") + 4))

Set dMappedDrives = CreateObject("Scripting.Dictionary")
Call BuildMappedDrivesDictionary()
Call MapDrive("Z:", sServerPath & "\" & sOU, True)

Set oTranslate = Nothing
Set oWShell = Nothing

Function GetDomain()
    On Error Resume Next

    Set oRootDSE = GetObject("LDAP://RootDSE")
    sTempDomain = oRootDSE.Get("DefaultNamingContext")
    GetDomain = Replace(Replace(sTempDomain, "DC=", "", 1, 10, VBTextCompare), ",", "")
    Set oRootDSE = Nothing
End Function

Sub MapDrive(sDrive, sSharePath, bForceDisconnect)
    On Error Resume Next
    '
    ' Check to see if the path is already mapped to the requested location
    '
    If dMappedDrives.Exists(sSharePath) Then
         If dMappedDrives.Item(sSharePath) = UCase(sDrive) Then
             Exit Sub
         Else
             If bForceDisconnect = True Then
                 oNetwork.RemoveNetworkDrive dMappedDrives.Item(sSharePath), True, True
                 dMappedDrives.Remove(dMappedDrives.Item(sSharePath))
                 dMappedDrives.Remove(sSharePath)
             End If
             Err.Clear
         End If
    End If
    '
    ' Loop through drives to check if there is an existing mapping
    '
    If dMappedDrives.Exists(UCase(sDrive)) Then
        If UCase(dMappedDrives.Item(sDrive)) = UCase(sSharePath) Then
            Exit Sub
        Else
            If bForceDisconnect = True Then
                Err.Clear
                oNetwork.RemoveNetworkDrive sDrive, True, True
                If Err.Number <> 0 Then Exit Sub
                dMappedDrives.Remove(dMappedDrives.Item(sDrive))
                dMappedDrives.Remove(sDrive)
            Else
                Exit Sub
            End If
        End If
    End If
    '
    ' Now the drive letter is free, so map the drive
    '
    Err.Clear
    oNetwork.MapNetworkDrive UCase(sDrive), sSharePath, True
    If Err.Number <> 0 Then
        Msgbox "Failed to map " & sDrive & " to " & sSharePath & "."
    Else
        Msgbox "The drive is mapped."
    End If
End Sub

Sub BuildMappedDrivesDictionary()
    On Error Resume Next
    Const HKEY_CURRENT_USER = &H80000001
    Set oRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
 
    oRegistry.EnumKey HKEY_CURRENT_USER, "Network\", aSubKeys
 
    For Each oSubKey In aSubKeys
        sTempPath = oShell.RegRead("HKCU\Network\" & oSubKey & "\RemotePath")
        If Not dMappedDrives.Exists(sTempPath) Then dMappedDrives.Add sTempPath, UCase(oSubKey & ":")
        dMappedDrives.Add UCase(oSubKey & ":"), sTempPath
    Next
    Set oRegistry = Nothing
End Sub

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 33713329
Hi, you should just be able to identify the parent ou that the user is in, and map the drive accordingly.

Regards,

Rob.
Set objADSysInfo = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objADSysInfo.UserName)
strOU = Mid(Split(objUser.Parent, ",")(0), 4)
Set objNetwork = CreateObject("WScript.Network")
MsgBox "Your parent OU is " & strOU
Select Case strOU
	Case "IT"
		objNetwork.MapNetworkDrive "Z:", "\\server\ITShare"
	Case "HR"
		objNetwork.MapNetworkDrive "Z:", "\\server\HRShare"
End Select

Open in new window

0
 

Author Comment

by:teksalah
ID: 33713871
Hi Robsampson,

The script is running and it displays the OU name in the format: "your parent OU is P://OU=ITDEPT". But drives are not mapping.

my script
----
Set objADSysInfo = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objADSysInfo.UserName)
strOU = Mid(Split(objUser.Parent, ",")(0), 4)
Set objNetwork = CreateObject("WScript.Network")
MsgBox "Your parent OU is " &strOU
Select Case strOU
      Case "ITDEPT"
            objNetwork.MapNetworkDrive "Z:", "\\192.168.1.245\home\ITDEPT"
      Case "ACCOUNTS"
            objNetwork.MapNetworkDrive "Z:", "\\192.168.1.245\home\ACCOUNTS"
End Select
----

teks
0
Efficient way to get backups off site to Azure

This user guide provides instructions on how to deploy and configure both a StoneFly Scale Out NAS Enterprise Cloud Drive virtual machine and Veeam Cloud Connect in the Microsoft Azure Cloud.

 
LVL 65

Expert Comment

by:RobSampson
ID: 33713900
Oh sorry....need to strip more off that...
Change this line
strOU = Mid(Split(objUser.Parent, ",")(0), 4)

to this
strOU = Mid(Split(objUser.Parent, ",")(0), 11)

Regards,

Rob.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 33713902
Then you should see
your parent OU is ITDEPT

Regards,

Rob.
0
 

Author Comment

by:teksalah
ID: 33713917
How I can display only user name and OU name. no other characters

teks
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 33713933
Something like this?

Rob.
Set objADSysInfo = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objADSysInfo.UserName)
strOU = Mid(Split(objUser.Parent, ",")(0), 11)
Set objNetwork = CreateObject("WScript.Network")
MsgBox "Username: " & objNetwork.Username & VbCrLf & "OU: " & strOU
Select Case strOU
	Case "IT"
		objNetwork.MapNetworkDrive "Z:", "\\server\ITShare"
	Case "HR"
		objNetwork.MapNetworkDrive "Z:", "\\server\HRShare"
End Select

Open in new window

0
 

Author Closing Comment

by:teksalah
ID: 33713978
Excellent.. thanks
0
 
LVL 8

Expert Comment

by:spinzr0
ID: 33716040
Just curious, did my code not work?  IT has a lot more error checking an options.
0

Featured Post

Is Your AD Toolbox Looking More Like a Toybox?

Managing Active Directory can get complicated.  Often, the native tools for managing AD are just not up to the task.  The largest Active Directory installations in the world have relied on one tool to manage their day-to-day administration tasks: Hyena. Start your trial today.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Scenario:  You do full backups to a internal hard drive in either product (SBS or Server 2008).  All goes well for a very long time.  One day, backups begin to fail with a message that the disk is full.  Your disk contains many, many more backups th…
With User Account Control (UAC) enabled in Windows 7, one needs to open an elevated Command Prompt in order to run scripts under administrative privileges. Although the elevated Command Prompt accomplishes the task, the question How to run as script…
This tutorial will walk an individual through setting the global and backup job media overwrite and protection periods in Backup Exec 2012. Log onto the Backup Exec Central Administration Server. Examine the services. If all or most of them are stop…
This Micro Tutorial hows how you can integrate  Mac OSX to a Windows Active Directory Domain. Apple has made it easy to allow users to bind their macs to a windows domain with relative ease. The following video show how to bind OSX Mavericks to …

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question