Vista - Script Mapping all Drives

I found this script online and it works but it maps all the drives not just
those for a group. We we have 2003 R2 AD. Any Ideas?

On Error Resume Next

Dim GroupList
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
Set WshNetwork = WScript.CreateObject("WScript.Network")

GetGroupInfo()

LogonPath = fso.GetParentFolderName(WScript.ScriptFullName)

'**************************************Group Mappings Based on
Grouplist.csv*********************************

If fso.FileExists(logonpath&"\Grouplist.csv") Then
Set grplist = Fso.OpenTextFile(logonpath&"\Grouplist.csv")
'make File into an Array
aGroup = Split(grplist.Readall,vbcrlf)
For I = 0 to UBound(GroupList) ' Check Every Group Membership the user is
in (populated into Grouplist)
grpname = Grouplist(i)
For x = 0 to UBound(aGroup) ' Read the entire CSV to make sure all drives
are mapped for each Group
mapline = aGroup(x)

If InStr(LCase(mapline),LCase(grpname)) Then ' If you're in the group
mapline = Mid(mapline,InStr(mapline,",")+1) ' Remove the GroupName
from the line
Drive = Left(mapline,InStr(mapline,",")-1) ' Extract Drive Letter
Path = Mid(mapline,InStr(mapline,",")+1) ' Extract the path



'If (fso.DriveExists(drive)= True)Then ' Ifthe drive mapping is stale,
remove it
' WshNetwork.RemoveNetworkDrive Drive
' drive,true,true
'End If


'If (fso.DriveExists(drive) <> True) and (Drive<>"!!") Then ' If The
Drive is not already mapped
WshNetwork.MapNetworkDrive drive,path,false ' Map The Drive
wscript.sleep 1000

'End If


' If Drive = "!!" then
' WSHNetwork.AddWindowsPrinterConnection Path
' wscript.sleep 1000
'end if
'End If
End IF
Next
Next
End IF

Sub GetGroupInfo
Set UserObj = GetObject("WinNT://" & wshNetwork.UserDomain & "/" &
WshNetwork.UserName)'WinNT
Set Groups = UserObj.groups

For Each Group In Groups
GroupCount = GroupCount + 1
Next

ReDim GroupList(GroupCount -1)
i = 0
For Each Group In Groups
GroupList(i) = Group.Name
i = i + 1
Next
End Sub

"NBullock" <niel_bullock@xxxxxx> wrote in message
news:%23UHpzJewJHA.956@xxxxxxFirst step is to remove the "On Error Resume Next" statement. The statement
makes troubleshooting nearly impossible. The script is very complicated,
unnecessarily so.

In this case the csv file is assumed to be a list of group names, one per
line. The script compares the value read from each line of the file with the
names of the groups the user is a direct member of. If there is a match, the
code then attempts to parse the group name for path and drive. But, of
course, this will never happen because the entire line is being compared to
the group name, so if the line includes drive and path information there
cannot be a match.

I'm going to guess that the csv file has the following format:

<Group Name>,<drive letter>,<path>

For example:

Group1,k:,\\server1\share1
Group2,m:,\\server1\share2

If so, a solution could be similar to below (limited testing has been done
on this):
===================
Option Explicit

Dim objNetwork, arrList()
Dim objFSO, strFile, objFile, strScriptPath
Dim objUser, strLine, strGroup, strDrive, strPath
Dim intIndex, objList, objGroup

Const ForReading = 1

Set objNetwork = CreateObject("Wscript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strScriptPath = objFSO.GetParentFolderName(Wscript.ScriptFullName)
strFile = "GroupList.csv"

' Setup dictionary object to track user groups.
Set objList = CreateObject("Scripting.Dictionary")
objList.CompareMode = vbTextCompare

' Bind to the current user object.
Set objUser = GetObject("WinNT://" & objNetwork.UserDomain _
& "/" & objNetwork.UserName)

For Each objGroup In objUser.Groups
objList.Add objGroup.Name, True
Next

' Check if csv file exists.
If (objFSO.FileExists(strScriptPath & "\" & strFile) = True) Then
' Open the file for reading.
Set objFile = objFSO.OpenTextFile(strScriptPath & "\" & strFile,
ForReading)
Do Until objFile.AtEndOfStream
strLine = Trim(objFile.ReadLine)
' Skip blanklines.
If (strLine <> "") Then
' Parse for group name, drive, and path.
' Only map drives if all values found.
intIndex = InStr(strLine, ",")
If (intIndex > 0) Then
strGroup = Left(strLine, intIndex - 1)
strLine = Mid(strLine, intIndex + 1)
intIndex = InStr(strLine, ",")
If (intIndex > 0) Then
strDrive = Left(strLine, intIndex - 1)
strPath = Mid(strLine, intIndex + 1)
' Check if user is a member of this group.
If (objList.Exists(strGroup) = True) Then
' Map the drive.
objNetwork.MapNetworkDrive strDrive, strPath, False
End If
End If
End If
End If
Loop
objFile.Close
End If

--
Richard Mueller
MVP Directory Services
Hilltop Lab - http://www.rlmueller.net
--

--
Richard Mueller
MVP Directory Services
Hilltop Lab - http://www.rlmueller.net
--

Thanks, I will test that today.

"Richard Mueller [MVP]" <rlmueller-nospam@xxxxxx> wrote in
message news:uSJJtLhwJHA.1492@xxxxxx

This maps the drives perfectly. However, it errors if the drives are all
ready mapped. Should code be added to remove all drives, and then re-map?
That would make sure that the mappings are dynamically updated as the
Group.csv is.



"Richard Mueller [MVP]" <rlmueller-nospam@xxxxxx> wrote in
message news:uSJJtLhwJHA.1492@xxxxxx

Good point. I put the script together quickly, but a logon script should
handle all such situations. In this case the best approach is probably to
trap the error and then remove the existing mapping. I like to always
specify to not make the mapping persistent, and if there is an existing
mapping to remove the persistence feature. The modification would be to
replace this snippet:

If (objList.Exists(strGroup) = True) Then
' Map the drive.
objNetwork.MapNetworkDrive strDrive, strPath, False
End If

with this:

If (objList.Exists(strGroup) = True) Then
' Map the drive. Trap error if a mapping exists for
this drive.
On Error Resume Next
objNetwork.MapNetworkDrive strDrive, strPath, False
If (Err.Number <> 0) Then
' Restore normal error handling.
On Error GoTo 0
' Remove any existing mapping.
objNetwork.RemoveNetworkDrive strDrive, True,
True
' Try again without error trapping.
objNetwork.MapNetworkDrive strDrive, strPath,
False
End If
' Restore normal error handling.
On Error GoTo 0
End If

In the modified code if the mapping fails I assume it is because there is an
existing mapping. I attempt to remove it and remove the persistence. I then
make a second attempt to map the drive. On the second attempt I do not trap
any possible error. The reason is that I want the user to get an error
message. Otherwise I will never know there is a problem. My philosophy is
that such error messages should not be suppressed because they indicate
problems that should be fixed. Also, I do not remove all existing drive
mappings, only the ones that conflict with the standard mappings enforced by
the logon script. I let the user create their own mappings as long as they
do not conflict. If instead you decide to not allow these user created
mappings to persist, you can enumerate all mappings first and remove them. I
would need to look up how to do that.

--
Richard Mueller
MVP Directory Services
Hilltop Lab - http://www.rlmueller.net
--
"NBullock" <niel_bullock@xxxxxx> wrote in message
news:OFxKq8owJHA.528@xxxxxx

If you decide you would rather remove all existing drive mappings before
mapping your standard ones, the code would be similar to:
========
' Declare new variable.
Dim k
' Enumerate all network drive mappings.
Set objDrives = objNetwork.EnumNetworkDrives
For k = 0 to objDrives.Count - 1 Step 2
objNetwork.RemoveNetworkDrive objDrives(k), True, True
Next
=====
The above snippet would be placed after the objNetwork object reference is
created, and before the csv file is read.

--
Richard Mueller
MVP Directory Services
Hilltop Lab - http://www.rlmueller.net
--
"NBullock" <niel_bullock@xxxxxx> wrote in message
news:OFxKq8owJHA.528@xxxxxx

Genius! It works perfectly.

Thanks


"Richard Mueller [MVP]" <rlmueller-nospam@xxxxxx> wrote in
message news:uO%23biWpwJHA.5900@xxxxxx

I thought about that. I will check with are team here. It would be nice to
get rid of any manually mapped drives too.

Thanks Again!


"Richard Mueller [MVP]" <rlmueller-nospam@xxxxxx> wrote in
message news:O%23v$OkpwJHA.5472@xxxxxx

Hello Richard,
Perhaps you can help again. I have modified the code as you recommended and
I am seeing this error for no apparent, and at random.

Script: Path and name
Line: 5
Character: 7
The network connection does not exist.
Code: 800708CA
Source: WSHNetwork.RemoveNetworkDrive

Here is my final code:
Option Explicit
Dim objNetwork, arrList()
Dim objFSO, strFile, objFile, strScriptPath
Dim objUser, strLine, strGroup, strDrive, strPath
Dim intIndex, objList, objGroup



Const ForReading = 1

Set objNetwork = CreateObject("Wscript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strScriptPath = objFSO.GetParentFolderName(Wscript.ScriptFullName)
strFile = "GroupList.csv"

' Setup dictionary object to track user groups.
Set objList = CreateObject("Scripting.Dictionary")
objList.CompareMode = vbTextCompare

' Bind to the current user object.
Set objUser = GetObject("WinNT://" & objNetwork.UserDomain & "/" &
objNetwork.UserName)

For Each objGroup In objUser.Groups
objList.Add objGroup.Name, True
Next

' Check if csv file exists.
If (objFSO.FileExists(strScriptPath & "\" & strFile) = True) Then
' Open the file for reading.
Set objFile = objFSO.OpenTextFile(strScriptPath & "\" &
strFile,ForReading)
Do Until objFile.AtEndOfStream
strLine = Trim(objFile.ReadLine)
' Skip blanklines.
If (strLine <> "") Then
' Parse for group name, drive, and path.
' Only map drives if all values found.
intIndex = InStr(strLine, ",")
If (intIndex > 0) Then
strGroup = Left(strLine, intIndex - 1)
strLine = Mid(strLine, intIndex + 1)
intIndex = InStr(strLine, ",")
If (intIndex > 0) Then
strDrive = Left(strLine, intIndex - 1)
strPath = Mid(strLine, intIndex + 1)
' Check if user is a member of this group.
If (objList.Exists(strGroup) = True) Then
' Map the drive. Trap error if a mapping exists for this drive.
On Error Resume Next
objNetwork.MapNetworkDrive strDrive, strPath, False
If (Err.Number <> 0) Then
' Restore normal error handling.
On Error GoTo 0
' Remove any existing mapping.
objNetwork.RemoveNetworkDrive strDrive, True,True
' Try again without error trapping.
objNetwork.MapNetworkDrive strDrive, strPath, False
End If
'Restore normal error handling.
On Error GoTo 0
End If
End If
End If
End If
Loop
objFile.Close
End If





"NBullock" <niel_bullock@xxxxxx> wrote in message
news:e2zdjnpwJHA.6040@xxxxxx