Solved

VB script to get OU name and username

Posted on 2010-09-19
9
509 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
 
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
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
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

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

OfficeMate Freezes on login or does not load after login credentials are input.
Restoring deleted objects in Active Directory has been a standard feature in Active Directory for many years, yet some admins may not know what is available.
This tutorial will walk an individual through locating and launching the BEUtility application to properly change the service account username and\or password in situation where it may be necessary or where the password has been inadvertently change…
This tutorial will walk an individual through the steps necessary to enable the VMware\Hyper-V licensed feature of Backup Exec 2012. In addition, how to add a VMware server and configure a backup job. The first step is to acquire the necessary licen…

707 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

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now