Link to home
Create AccountLog in
Avatar of Lico_w

asked on

VBScript to copy files from a share to a local drive

I'm trying to create a script to do the above, can someone give me some guidance on the best way to do it pls?

The code I have so far is below but doesn't work as I would expect:

set fso = CreateObject("Scripting.FileSystemObject")
sCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
moveToDrive = "D:\"
set failures = fso.CreateTextFile(moveToDrive & "failures.txt")
Set objFolder = fso.GetFolder(sCurPath)

ShowSubFolders objFolder, fso

WScript.Echo "The operation has successfully completed."

Sub ShowSubFolders(objFolder, fso)
    On Error Resume Next
	fso.CopyFolder objFolder, moveToDrive
    Set colFiles = objFolder.Files
    For Each objFile In colFiles
			objFilePath = objFile.Path
			objFileName = objFile.Name
			strLen = len(objFilePath)
			moveToLocation = right(objFilePath, (strLen - 3))
			wscript.echo moveToDrive & moveToLocation
			fso.CopyFile objFile, "D:\Documents and Settings\t104ahe\Desktop\Copy script test\" & objFileName
			fso.CopyFile objFile, moveToDrive & moveToLocation
			If Err.number <> 0 Then 
				failures.WriteLine "Error copying " & objFile.Path
			End if
			On Error GoTo 0
  Set colFolders = objFolder.SubFolders
  For Each objSubFolder In colFolders
    ShowSubFolders objSubFolder, fso
  If Err.number <> 0 Then 
	failures.WriteLine "Error copying " & objFile.Path
  End if
  On Error GoTo 0
End Sub

Open in new window

Avatar of David Lee
David Lee
Flag of United States of America image

Hi, Lico_w.

Do you need to copy the files from subfolders too or just from one folder?
Avatar of Lico_w


Hi, I need all folders and subfolders as well as all files contained within each
WHY go through all this trouble....just use Robocopy...painless and done in minutes.
Does the script need to create the folders as it goes, or will they already exist?
Hi Lico_w

If you simply want to copy a folder and it's contents have you considered scripting things like robocopy?

I use it all the time as it's options are so versatile.

I agree with @mcse2007 and @jawa29 that you'd probably be better off using an off-the-shelf tool rather than spending the time creating your own script.  That said, if you do want to pursue a script, then here's how I'd go about it.  Since you've said that you want to copy all files and subfolders under the target folder it's far more efficient to copy the folder itself rather than iterate through the subfolders and files copying each.  This script simply copies the source folder (which gets everything under it) to the target folder.  Just edit the source and target paths on line 3.
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
CopyFolder "\\Server\Share\Folder", "C:\Folder"
Set objFSO = Nothing

Sub CopyFolder(strFolder, strTarget)
	Dim objFld, strLastFolder
	Set objFld = objFSO.GetFolder(strFolder)
	strLastFolder =
	objFld.Copy strTarget & "\" & strLastFolder, True
	Set objFld = Nothing
End Sub

Open in new window

Avatar of Lico_w


Thanks for your comments but this is win 2003 server so not sure robocopy is available...? If so can you provide some instructions on how to use please?
Avatar of jawa29
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
Create an account to see this answer
Signing up is free. No credit card required.
Create Account