• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 572
  • Last Modified:

VB script to get OU name and username

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
teksalah
Asked:
teksalah
  • 4
  • 3
  • 2
1 Solution
 
spinzr0Commented:
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
 
RobSampsonCommented:
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
 
teksalahAuthor Commented:
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
Simplify Active Directory Administration

Administration of Active Directory does not have to be hard.  Too often what should be a simple task is made more difficult than it needs to be.The solution?  Hyena from SystemTools Software.  With ease-of-use as well as powerful importing and bulk updating capabilities.

 
RobSampsonCommented:
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
 
RobSampsonCommented:
Then you should see
your parent OU is ITDEPT

Regards,

Rob.
0
 
teksalahAuthor Commented:
How I can display only user name and OU name. no other characters

teks
0
 
RobSampsonCommented:
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
 
teksalahAuthor Commented:
Excellent.. thanks
0
 
spinzr0Commented:
Just curious, did my code not work?  IT has a lot more error checking an options.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 4
  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now