Everything works in this script with the exception of actually copying the files down from the W2K03 server to the user's Desktop\Shortcut folder. The Shortcut folder does get created by nothing gets copied to it. I have checked all the folder and file rights and they are correct. I am new to vb so I am at my wits end trying to find out why this isn't working. Any help appreciated. Oh and I just changed all the server names to server01 in the script.
Thanks Cindy
_______________________
Option Explicit
On Error Resume Next
Dim strMessage
Dim wshNetwork
Dim ADSysInfo
Dim CurrentUser
Dim strGroups
Dim objFSO, wshShell, file, FileExt
Dim envVar, strProfilePath, strUserName, strSubFolders, strSubLocations, strSource, strDestination, strShortCut
Dim arrayFolders, arrayPaths, x, rootFolder
Set objFSO = CreateObject("Scripting.FileSystemObject")
set wshShell = Wscript.CreateObject("Wscript.Shell")
Set envVar = wshShell.Environment("PROCESS")
strProfilePath = envVar.Item("USERPROFILE")
strUserName = envVar.Item("USERNAME")
Set wshNetwork = CreateObject("WScript.Network")
Set ADSysInfo = CreateObject("ADSystemInfo")
Set CurrentUser = GetObject("LDAP://" & ADSysInfo.UserName)
strSubFolders = ""
strSubLocations = ""
strGroups = UCase(Join(CurrentUser.MemberOf))
'*************************************************
' Drive mappings
'*************************************************
'General Mappings for all
wshNetwork.MapNetworkDrive "G:", "\\server01\Share\Section"
wshNetwork.MapNetworkDrive "K:", \\server01\Share\Apps
' Bond O: drive to Outbound's H: drive
If InStr(strGroups, "Bonds") Then
wshNetwork.MapNetworkDrive "O:", "\\server01\Users\Outbound\ECSBonds"
If Err <> 0 Then
Call Error_Handler("Create BONDS O: drive")
End If
End If
' Receivable O: drive to Outbound's H: drive
If InStr(strGroups, "Receivables") Then
wshNetwork.MapNetworkDrive "O:", "\\server01\Users\Outbound\RECdown"
If Err <> 0 Then
Call Error_Handler("Create Receiables O: drive")
End If
End If
' Collections O: drive to Outbound's H: drive
If InStr(strGroups, "Collections") Then
wshNetwork.MapNetworkDrive "O:", "\\server01\Users\Outbound\COLLDown"
If Err <> 0 Then
Call Error_Handler("Create Collections O: drive")
End If
End If
' Map to shared directory at HQ-OFM
If InStr(strGroups, "OFM Shared") Then
wshNetwork.MapNetworkDrive "S:", "\\server01\Share"
If Err <> 0 Then
Call Error_Handler("Create OFM Shared S: drive")
End If
End If
' Map to shared drive at HQ-OFM
If InStr(strGroups, "OFM Shared 2") Then
wshNetwork.MapNetworkDrive "S:", "\\server01\Share"
wshNetwork.MapNetworkDrive "R:", "\\server01\Share"
If Err <> 0 Then
Call Error_Handler("Create OFM Shared S: drive")
End If
End If
' Map T: drive for FFMS Test
If InStr(strGroups, "FFMS Test") Then
wshNetwork.MapNetworkDrive "T:", "\\server01\Share\FFMS Test"
If Err <> 0 Then
Call Error_Handler("Create FFMS Test T: drive")
End If
End If
' Map U: drive for FFMS User Training
If InStr(strGroups, "FFMS Training") Then
wshNetwork.MapNetworkDrive "U:", "\\server01\Share\FFMS Training"
If Err <> 0 Then
Call Error_Handler("Create FFMS Training U: drive")
End If
End If
'-------------------------------------------------
'********* User's Desktop shortcuts ********************
strSource = \\server01\Share\Shortcuts
strDestination = strProfilePath & "\Desktop\Shortcuts"
strShortCut = strProfilePath & "\Desktop\Start Menu"
If InStr(strGroups,"DMC Users - ICE") > 0 then
strSubFolders = strSubFolders & "General" & ";"
strSubLocations = strSubLocations & strSource & "\General" & ";"
End If
If InStr(strGroups,"DMC Users - ICE") > 0 then
strSubFolders = strSubfolders & "IQ Objects" & ";"
strSubLocations = strSubLocations & strSource & "\IQ Objects" & ";"
End If
arrayFolders = split(strSubfolders,";")
arrayPaths = split(strSubLocations,";")
on error resume next
objFSO.CreateFolder strDestination
'Copies over appropriate shortcuts
For x = 0 to UBound(arrayFolders)-1
set rootFolder = objFSO.GetFolder(arrayPaths(x))
For each file in rootFolder.Files
FileExt = objFSO.GetExtensionName(file.name)
objFSO.CopyFile file.path, strDestination & "\" & file.name, True
Next
Next
set objFSO=Nothing
set envVar=Nothing
set WshNetwork=Nothing
set wshShell=Nothing