Creating an Xcopy Command (1 Viewer)

Hi

Could anybody tell me how I can get this code into a VB Script

xcopy P:\DATA.* C:\Database_Search /i /f /y

Basically when the CmdButton is clicked it copies all the “DATA” files from P:\ to the folder C:\Database_Search. Additionally, if the destination folder does not exist it must create one and if the file exists it must always overwrite it.

It must also be flexible enough to work in a WIN98, NT4, WIN2K and XP environment.

At the moment I have it in a batch file which I execute like this in a VB script

Call Shell("C:\Database_Search\Rupload.bat", 1)

BradleyS, I've used the techniques in this article to run commands "DOS" command from within Access: HOW TO: Determine When a Shelled Process Ends in Access 2000 . Not sure though, if it will work in Win98. I've used it in NT, so I'm guessing it will work with 2000 and XP. I've also used it in Access 97, even though the article mentions Access 2000.

Hi

I will give it a go, but it looks a lot of work for someone who hasn't got hardly any knowledge of VB.

Its funny how a simple DOS command like xcopy can be so complicated in VB, I thought it would be easier not harder.

Yeah, there's a lot of stuff in that article, but I was able to use it years ago when I knew even less about VBA than I do now. It should be too hard.

I'm sorry I can't get to grips with this!

I can open an application, but I want to be able to create a folder and copy files from one location to another and I don't know how to write this in VB code.

I think all you need to do is follow the instructions, but replace the line that says:

ExecCmd "NOTEPAD.EXE"
with
ExecCmd "c:\winnt\system32\xcopy.exe P:\DATA.* C:\Database_Search /i /f /y "

Replace c:\winnt\system32\ with your actual path to the xcopy.exe command. Have you tried that?

Hi

OK I understand now, yes that looks good.

But it's opening the xcopy window, then it closes and pops up the finished message.

But it doesnt run the copy commend line, nothing has been copied

Also how do I get my CmdButton on the form to run the Module

You're saying that the xcopy command doesn't even run? That's not good. I'll take a look at the code.

You should remove this line:
MsgBox "Process Finished" so it won't give you the message.

To have your command button run the code, put that ExecCmd command into the On Click event of the button.

Try this...

HTH

Hi

That works fine.

However, I can't copy the folder so I changed it to "CopyFile".

But the Folder must exist for it to copy the files, so I wrote in "CreateFolder" in the same way. That worked great!

But if you execute it again it brings up an error because the folder already exists.

I think I need an If Exist GoTo CopyFile, could you give me an idea of how I write this into the code.

My code looks like this, I hope I did it correctly?

Dim oFileSys As Object
Dim oMkDir As Object

Set oMkDir = CreateObject("Scripting.FileSystemObject")
oMkDir.CreateFolder ("C:\Database_Search")

Set oFileSys = CreateObject("Scripting.FileSystemObject")
oFileSys.copyfile "P:\DATA.*", "C:\Database_Search"

MsgBox "Copying is complete."

Also am I right in presuming that it will automatically, Overwrite with CopyFile unless I put False at the end, because I always want it to Overwite.

Try this... That will ensure the directory exists and create it if needed. All files in the strSource directory
will be copied to the strDestination and all files in the strDestination will be over written if
they already exist. Sub folders within will not be copied.

HTH

Sorry I have been away for a few days

This works great now!

Thanks for all your help!

A testament to the search function

It took a little more than an hour but this post gave me the information I was looking for. It was posted in July of 2003 but it does exactly what I need it to do. Thanks ghudson!

Your welcome! And for your "searching" efforts; I have awarded you 1 positive reputation point.

I know, I'm late but here my working Access VBA function code. Thanks to everybody for the help!

Public Function CopyDeleteFolder()
Call CopyAllFilesInFolder("C:\Source", "C:\Destination")
Call DeleteAllFilesInFolder("C:\Source")
End Function

Public Function CopyAllFilesInFolder(SourceFolder, DestinationFolder)
'********
' You need to have the SCRRUN.DLL library loaded. To do this, select
' Tools/References menu item and check 'Microsoft Scripting Runtime'
'********
On Error GoTo Err_CopyAllFilesInFolder
Dim FSO As New FileSystemObject
Dim FSO_Fldr, FSO_File
Dim strSource As String, strDestination As String, strFileName As String
If Dir(DestinationFolder, vbDirectory) = "" Then
MkDir DestinationFolder
End If
strSource = SourceFolder
strDestination = DestinationFolder & "\"
' Don’t forghet the slash or you got a "Run-time error '70' Permission denied"
Set FSO_Fldr = FSO.GetFolder(strSource)
For Each FSO_File In FSO_Fldr.Files
FSO_File.Copy strDestination
Next
Set FSO_Fldr = Nothing
Exit_CopyAllFilesInFolder:
Exit Function
Err_CopyAllFilesInFolder:
MsgBox Err.Description
Resume Exit_CopyAllFilesInFolder
End Function

Public Function DeleteAllFilesInFolder(SourceFolder)
'********
' You need to have the SCRRUN.DLL library loaded. To do this, select
' Tools/References menu item and check 'Microsoft Scripting Runtime'
'********
On Error GoTo Err_DeleteAllFilesInFolder
Dim FSO As New FileSystemObject
Dim FSO_Fldr, FSO_File
Dim strFileName As String
Set FSO_Fldr = FSO.GetFolder(SourceFolder)
For Each FSO_File In FSO_Fldr.Files
FSO_File.Delete
Next
Set FSO_Fldr = Nothing
Exit_DeleteAllFilesInFolder:
Exit Function
Err_DeleteAllFilesInFolder:
MsgBox Err.Description
Resume Exit_DeleteAllFilesInFolder
End Function

I know this is an old thread but I suspect there are others that still need a better xcopy that includes subfolders, I had not been able to find one on the net so I ended up writting one. Calling a shell to dos works ok but has a few drawbacks, 1st, unless you have a function to wait till the shelled application is complete (search for Shell-N-Wait) before continuing, you have to hold any following commands with a message box and wait till the shelled application is complete before clicking to continue.

A more recent problem I found is that our office is moving to Windows 7 64bit while still using Office 32bit, the calls I make using shell-n-wait are using kernal32 functions to wail till the shelled process is complete, then thunking the 64 os into a 32bit function it got very very slow to do what is normally a very fast function. This fix is still a little slower than normal but there are fewer thunk delays using vba.

This version copies (or moves) files and subfolders - it does not adjust attributes.

to include all the subfolders it recursively calls itself.

'**************************************************************
'*
'* XCOPY - in vba
'* Recursively copies files from source folder and subfolders to destination folder and subfolders
'* Optional MoveFlag (true/false) if 'True' will delete source data after a copy is complete
'*
'* [sFolder] is the source folder path ie: ("C:\SourceFolderName\") - MUST END WITH "\"
'* [dFolder] is the destination folder path ie: ("C:\DestinationFolderName\") - MUST END WITH "\"
'* RETURNS integer, count of files copied
'*
'* EXAMPLE
'* CopiedFileCount = FSO_XCopy("C:\SourceFolderName\","C:\DestinationFolderName\")
'*
'**************************************************************
Function FSO_XCopy(sFolder As String, dFolder As String, Optional MoveFlag As Boolean) As Integer

Dim FSO
Dim objFile
Dim objFolder
Dim objSubFolder
Dim objSubFolders
Dim fCount As Integer

If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\" 'fix folder id
If Right(dFolder, 1) <> "\" Then dFolder = dFolder & "\" 'fix folder id
fCount = 0

If Len(Dir(Left(sFolder, Len(dFolder) - 1), vbDirectory)) = 0 Then
MsgBox "Source folder not found for function FSO_XCopy!"
GoTo FSO_XCOPY_Exit:
End If

Set FSO = CreateObject("Scripting.FileSystemObject") 'opens sys file scripts

If Len(Dir(Left(dFolder, Len(dFolder) - 1), vbDirectory)) = 0 Then MkDir dFolder 'if the path does not exist, create it

Set objFolder = FSO.GetFolder(sFolder)
Set objSubFolders = objFolder.SubFolders
For Each objSubFolder In objSubFolders
fCount = fCount + FSO_XCopy(sFolder & objSubFolder.Name & "/", dFolder & objSubFolder.Name & "/", MoveFlag) 'recursive call to self for subfolder found
Next objSubFolder

'Copy files from target folder
For Each objFile In objFolder.Files
objFile.Copy dFolder
If MoveFlag Then objFile.Delete
fCount = fCount + 1
Next objFile
If MoveFlag Then objFolder.Delete

'Clean up
Set objSubFolders = Nothing
Set objFolder = Nothing
Set FSO = Nothing
FSO_XCOPY_Exit:
FSO_XCopy = fCount
End Function