?
Solved

VB script to get OU name and username

Posted on 2010-09-19
9
Medium Priority
?
530 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Get 15 Days FREE Full-Featured Trial

Benefit from a mission critical IT monitoring with Monitis Premium or get it FREE for your entry level monitoring needs.
-Over 200,000 users
-More than 300,000 websites monitored
-Used in 197 countries
-Recommended by 98% of users

 
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 2000 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

Are your AD admin tools letting you down?

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

OfficeMate Freezes on login or does not load after login credentials are input.
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
This tutorial will give a short introduction and overview of Backup Exec 2012 and how to navigate and perform basic functions. Click on the Backup Exec button in the upper left corner. From here, are global settings for the application such as conne…
This tutorial will show how to configure a single USB drive with a separate folder for each day of the week. This will allow each of the backups to be kept separate preventing the previous day’s backup from being overwritten. The USB drive must be s…
Suggested Courses

762 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