Copy files into user profile

[karl]

How can I copy a file from a server location into a new
folder in a user's profile on XP. I can create a folder
in the user profile in the following way, but how do I
then copy a file into that folder?

ParentFolder = &H28&
set objShell = CreateObject("Shell.Application")
set objFolder = objShell.NameSpace(ParentFolder)
objFolder.NewFolder "Application Data\Test"

[Peter Fonk]

Hi,

This code can copy to or from a profile directory, it works with
Windows 2000/XP Pro, all errors will be published in the eventlog.
At the following website you can find more information about the shell
copy method:

https://www.microsoft.com/technet/treeview/default.asp?url=/technet/scriptcenter/scrguide/sas_fil_vrwr.asp

For more information about the string functions such as Len or left
lock in the Windows Scripthost 5.6 documentation. You can find it at:

http://msdn.microsoft.com/library/default.asp?url=/downloads/list/webdev.asp

You must do a little reconstruction yob one the code to get every
thing one the
right lines again ! The webpage messed it up ;)

Goodluck,

Peter Fonk.

MCSA

'==========================================================================
'
' VBScript Source File -- Created with SAPIEN Technologies
PrimalSCRIPT(TM)
'
' NAME: Directory_copy.vbs
'
' AUTHOR: Peter Fonk
' DATE : 08-08-2003
'
' COMMENT: versie 1.0
'
'==========================================================================

Option Explicit

Directory_Copy "C:\Documents and Settings\%username%\Desktop\", "C:"

'Directory_Copy function, copies files from source to destination
location,
'use the %username% variable for the profile directory.
'usage = Directory_Copy "strSource", "strDestination"
'example1 = Directory_Copy "C:\Documents and
Settings\%username%\Desktop", "C:\test"
'example2 = Directory_Copy "C:\test", "C:\Documents and
Settings\%username%\Desktop"
Function Directory_Copy(strSource, strDestination)
ON ERROR RESUME NEXT

Const vbTextCompare = 1
Const strUsername = "%username%"
Const FOF_CREATEPROGRESSDLG = &H10& 'give permission to overwrite
files

Dim objDirectoryObject, objWshError, objWshNetwork, objShell,
objFolder
Dim varSpot, varCounter, strArray, strString

Set objDirectoryObject = CreateObject("Scripting.FileSystemObject")
Set objWshNetwork = CreateObject("WScript.Network")
Set objShell = CreateObject("Shell.Application")

varCounter = 0
strArray = Array(strSource, strDestination)

For Each strString In strArray

'check if strString the %username% variable contains,
'if present replace it with the username.
varSpot = InStr(1, strString, strUsername, vbTextCompare)
If varSpot > 0 Then

strString = Left(strString, varSpot - 1) & objWshNetwork.UserName &
_
Mid(strString, varSpot + Len(strUsername))
Else
End If

varSpot = Right(strString, 1)
' strip backslash if present at the end of strString, otherwise
directory lockup will fail
If(varSpot = "\") Then
strString = Left(strString, Len(strString) - 1)
End If

strArray(varCounter) = strString
varCounter = varCounter + 1
Next
'overwrite strSource and strDestination
strSource = strArray(0)
strDestination = strArray(1)

'check if the source file exist.
If objDirectoryObject.FolderExists(strSource) then

'check if the destination location exist.
If objDirectoryObject.FolderExists(strDestination) then

'copy to the destination location
Set objFolder = objShell.NameSpace(strDestination)
objFolder.CopyHere strSource, FOF_CREATEPROGRESSDLG
Else
'if destination location not found write error in the eventlog
Set objWshError = WScript.CreateObject("WScript.Shell")
objWshError.LogEvent 1, "Error in: Directory_Copy Function,
Destination location " _
& Chr(34) & strDestination & Chr(34) & " not found or no access
Rigths."
Set objWshError = Nothing
End If
Else
'if source location not found write error in the eventlog
Set objWshError = WScript.CreateObject("WScript.Shell")
objWshError.LogEvent 1, "Error in: Directory_Copy Function, Source
location " _
& Chr(34) & strSource & Chr(34) & " not found or no access Rigths."
Set objWshError = Nothing
End If


'Catch any possible error and publish it to the Eventlog
If Err.Number <> 0 then

Set objWshError = WScript.CreateObject("WScript.Shell")
objWshError.LogEvent 1, "Error in: Login Script File_Copy Function
" _
& CStr(Err.Number) & " " & Err.Description
Set objWshError = Nothing
Err.Clear
else
End if
'Clear the objects

Set objWshNetwork = Nothing
Set objFile = Nothing
Set objFileObject = Nothing
End Function

"karl" <karl.r...@becta.org.uk> wrote in message news:<000101c352c6$ab6f0d90$a401...@phx.gbl>...

[Peter Fonk]

Hi,

I made a little mistake, the function can't copy to a rootdrive, only
directories. in the example is standing:

Directory_Copy "C:\Documents and Settings\%username%\Desktop\", "C:"

make from it:

Directory_Copy "C:\Documents and Settings\%username%\Desktop\",
"C:\test"

or something you wan't ;)

The rest just works fine.

Greetings,

Peter Fonk.

MCSA