Vista - Help

I am new to this programming thing as you all probably already know, but I
still need some help. The network that I help support is running all XP Pro
SP3. I haven't verified the vbscript version on all our machines, but I am
using 5.8 and 2 machines that will not execute the copyhere portion of the
script are also running 5.8. My guess is that it is a problem with the OS
because it will not execute the CopyHere from shell.application (line
47-66), but I cannot be 100% sure. Below is all of my code and I am sure
some of you may be upset that I am posting again, but everything is working
perfectly for about 99% of my machines now (Thanks Eric, Richard and others
who have helped). But now there is only a handfull of users it will not
work on. The reason I think it is the shell.application is because I also
use the Scripting.FileSystemObject to copy some files (line 76) within the
same script and that part of the code works perfectly 100% on all machines.

Any help would be nice. Again, thanks for your patience in helping me learn
some of this stuff...

James

On Error Resume Next

Set WshShell = WScript.CreateObject("WScript.Shell")
Set objNetwork = CreateObject("Wscript.Network")
Set objSHApp = CreateObject("Shell.Application")
Set filesys = CreateObject("Scripting.FileSystemObject")
Set WshSysEnv = WshShell.Environment("PROCESS")

'Set Network path
strNetworkPath = "\\kbafs01.kba.krollworldwide.com\users"

'Return User Name so can find User Folder on Network
strUserName = "\" & objNetwork.UserName

'Map G: drive
objNetwork.MapNetworkDrive "G:", strNetworkPath & strUserName, True
If (Err.Number <> 0) Then
objNetwork.RemoveNetworkDrive "G:", True, True
objNetwork.MapNetworkDrive "G:", strNetworkPath & strUserName, True
Err.clear
End If

'Map H: drive
objNetwork.MapNetworkDrive "H:", strNetworkPath, True
If (Err.Number <> 0) Then
objNetwork.RemoveNetworkDrive "H:", True, True
objNetwork.MapNetworkDrive "H:", strNetworkPath, True
Err.clear
End If

'Set destination
strDest = "G:\ProfileBackup\"

'Check if the ProfileBackup Folder exists, if not create it, if yes then
delete and re-create it
filesys.CreateFolder(strDest)

'Set Homepath
strHomePath = WshSysEnv("HOMEPATH")
strHomePath = "c:" & strHomePath

'Const FOF_NOCONFIRMATION = &H10& '(16)Respond with "Yes to All" for any
dialog box that is displayed
'Const FOF_SIMPLEPROGRESS = &H100& '(256)Display a progress dialog box but
do not show the file names
'Const FOF_NOCONFIRMMKDIR = &H200& '(512)Do not confirm the creation of a
new directory if the operation requires one to be created

' Using shell.application to copy since faster and displays status/progress

'Backup User Desktop
'filesys.CreateFolder strDest & "Desktop\"
objSHApp.Namespace(strDest).CopyHere strHomePath & "\desktop\",528

'Backup User Favorites
'filesys.CreateFolder strDest & "Favorites\"
objSHApp.Namespace(strDest).CopyHere strHomePath & "\Favorites\",528

'Backup User My Documents
'VS2008SP1ENUX1512962.iso
'filesys.CreateFolder strDest & "My Documents"
objSHApp.Namespace(strDest).CopyHere strHomePath & "\My Documents\",528

'Backup User PsiData (Need to check if folder exists on PC first)
'filesys.CreateFolder strDest & "PsiData\"
objSHApp.Namespace(strDest).CopyHere strHomePath & "\PsiData\",528

'Backup User Email Signatures (Need to check if folder exists on PC first)
'filesys.CreateFolder strDest & "Signatures\"
objSHApp.Namespace(strDest).CopyHere strHomePath & "\Application
Data\Microsoft\Signatures\",528

'Find the Wallpaper
Const HKEY_CURRENT_USER = &H80000001
strComputer = "."
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &
strComputer & "\root\default:StdRegProv")
strKeyPath = "Control Panel\Desktop\"
strKeyName = "Wallpaper"
objReg.GetSTRINGValue HKEY_CURRENT_USER,strKeyPath,strKeyName,szValue

'Backup Wallpaper
filesys.CreateFolder (strDest & "\Wallpaper\")
filesys.CopyFile szValue, (strDest & "\Wallpaper\")

'Backup file of mapped drive paths
strKeyPath = "Network\"
strKeyName = "RemotePath"
objReg.EnumKey HKEY_CURRENT_USER, strKeyPath, arrSubKeys
Set MyFile = filesys.CreateTextFile(strDest & "MappedDrives.txt", True)

For Each subkey In arrSubKeys
strKeyFolder = subkey
objReg.GetSTRINGValue HKEY_CURRENT_USER,strKeyPath & "\" &
subkey,strKeyName,szValue
intLength = Len(szValue)-1
strUncPath = Right(szValue, intLength)
MyFile.WriteLine subkey & ":" & strUncPath
Next

MyFile.Close

' clean up
Set objSHApp= nothing
Set objNetwork = nothing
Set objReg = nothing

BtnPress = WshShell.Popup("Profile Backup Successful ",7, "Profile
Backup", 0 + 64)

"James" <dontemailme@xxxxxx> wrote in message
news:OzSHdpbIKHA.4376@xxxxxxComment out your 'On Error Resume Next' at the top, run the script on one
of the computers that it does not work on and reply back with the error that
is thrown. Make sure to include all the text from the dialogue box.

James wrote:
I agree that a script that long is impossible to troubleshoot with "On Error
Resume Next". However, a few places require it. It should be used only where
necessary, then normal error handling restored with "On Error GoTo 0". Also,
do not test the script as a logon script. Run it after logon to make it sure
it works.

The code to map drives is written to use error trapping. Remove the existing
"On Error Resume Next". Then, for example, instead of:
========
'Map G: drive
objNetwork.MapNetworkDrive "G:", strNetworkPath & strUserName, True
If (Err.Number <> 0) Then
objNetwork.RemoveNetworkDrive "G:", True, True
objNetwork.MapNetworkDrive "G:", strNetworkPath & strUserName, True
Err.clear
End If
========
Use code like this:
=========
'Map G: drive
On Error Resume Next
objNetwork.MapNetworkDrive "G:", strNetworkPath & strUserName, True
If (Err.Number <> 0) Then
On Error GoTo 0
objNetwork.RemoveNetworkDrive "G:", True, True
objNetwork.MapNetworkDrive "G:", strNetworkPath & strUserName, True
End If
On Error GoTo 0
========
Next, this portion of the code won't do what the comment indicates you want
to do:
==========
'Set destination
strDest = "G:\ProfileBackup\"

'Check if the ProfileBackup Folder exists, if not create it, if yes then
delete and re-create it
filesys.CreateFolder(strDest)
========
This should be coded as follows:
==========
'Set destination
strDest = "G:\ProfileBackup"

'Check if the ProfileBackup Folder exists, if not create it, if yes then
delete and re-create it
If (filesys.FolderExists(strDest) = True) Then
filesys.DeleteFolder(strDest)
End If
filesys.CreateFolder(strDest)
========
Note I had to remove the trailing backslash from the folder name to make it
work. You will need to account for this later in the script.

There may be other problems, but they will show up if normal error handling
is enabled.

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

Richard Mueller [MVP] schrieb:
[...]Wouldn't

If filesys.FolderExists(strDest) Then
filesys.DeleteFolder strDest
End If
filesys.CreateFolder strDest

be even better?