-
Hi all,
Ok my scenario is this. My company has a network drive which contains some important Access 2.0 database file (mdb) for daily use. My department has to backup all of them everyday. Due to that they're in different directory, I have written a program to just copy them to the backup folder.
I use the FileCopy function to copy but there is one problem. Some of the staff might still be using the file while I'm backing up and cos of this, FileCopy doesn't allows me to copy this anymore and I will have to turn to Window Explorer to copy this specify files which are not copied over by the program (it works in Explorer somehow)
So is there any VB functions or codings that allows me to still able to backup my files just like the Window Explorer copying?
Thanks for any help!! :)
-
You can try using the SHFileOperation API to access Windows Explorer's copy file function. The code below should work for you (I've tried it on Win98 and Win2000), provided that you change directory name to where you want to copy your files to.
Code:
Private Sub Command1_Click()
Dim lret As Long
Dim fileop As SHFILEOPSTRUCT
With fileop
.hwnd = 0
.wFunc = FO_COPY
.pFrom = "C:\Windows\desktop" & _
vbNullChar & vbNullChar
.pTo = "c:\Backup of Documents" & vbNullChar & vbNullChar
.lpszProgressTitle = "Please wait, backing up..."
.fFlags = FOF_SIMPLEPROGRESS Or FOF_RENAMEONCOLLISION
End With
lret = SHFileOperation(fileop)
If result <> 0 Then 'Operation failed
MsgBox Err.LastDllError 'Show the error returned from the API.
Else
If fileop.fAnyOperationsAborted <> 0 Then
MsgBox "Operation Failed"
End If
End If
End Sub
In a module
Code:
Public Declare Function SHFileOperation Lib _
"shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As Any) As Long
Public Declare Sub SHFreeNameMappings Lib _
"shell32.dll" (ByVal hNameMappings As Long)
Public Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource _
As Any, ByVal cbCopy As Long)
Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As FO_Functions
pFrom As String
pTo As String
fFlags As FOF_Flags
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String 'only used if FOF_SIMPLEPROGRESS
End Type
Public Enum FO_Functions
FO_MOVE = &H1
FO_COPY = &H2
FO_DELETE = &H3
FO_RENAME = &H4
End Enum
Public Enum FOF_Flags
FOF_MULTIDESTFILES = &H1
FOF_CONFIRMMOUSE = &H2
FOF_SILENT = &H4
FOF_RENAMEONCOLLISION = &H8
FOF_NOCONFIRMATION = &H10
FOF_WANTMAPPINGHANDLE = &H20
FOF_ALLOWUNDO = &H40
FOF_FILESONLY = &H80
FOF_SIMPLEPROGRESS = &H100
FOF_NOCONFIRMMKDIR = &H200
FOF_NOERRORUI = &H400
FOF_NOCOPYSECURITYATTRIBS = &H800
FOF_NORECURSION = &H1000
FOF_NO_CONNECTED_ELEMENTS = &H2000
FOF_WANTNUKEWARNING = &H4000
End Enum
Public Type SHNAMEMAPPING
pszOldPath As String
pszNewPath As String
cchOldPath As Long
cchNewPath As Long
End Type
Hope this helps :)
-
Hi reeset,
Thanks for replying to my post.
I've try the following code (I'm using Win NT 4.0) but it gives me some memory errors and crash (jump out from VB). Do you know where the problem lies?
And also, where do I insert the filename from which I wants to copy. It's actually one file from a specify directory and another files from other directories.
Thanks a lot!!
-
(Sorry about the formating) :)
This is my bad. I quickly tested this on a Win98 machine, and neglected to tell you that on an NT platform, you have to remove the .lpszProgressTitle = "Please wait, backing up..." entry. It is only useful in Win95, but won't crash 98, so I forgot. Anyway, the SHFileOperation API is mostly good for moving folders. It can move individual folders, but not very well (at least I have always had problems). The problem is that it doesn't correctly name the copied file, because I think it is looking to copy the contents of folders, not individual files. Anyway, if you paste this into your project, this should work with the problem mentioned above.
Code:
Private Sub Command1_Click()
Dim lret As Long
Dim fileop As SHFILEOPSTRUCT
With fileop
.hwnd = 0
.wFunc = FO_COPY
.pFrom = "d:\oclcapps\print.vbs" & _
vbNullChar & vbNullChar 'You would change this value for different files
.pTo = "c:\Backup\Backup of Documents" & vbNullChar & vbNullChar
.fFlags = FOF_SIMPLEPROGRESS Or FOF_RENAMEONCOLLISION
End With
lret = SHFileOperation(fileop)
If result <> 0 Then 'Operation failed
MsgBox Err.LastDllError 'Show the error returned from the API.
Else
If fileop.fAnyOperationsAborted <> 0 Then
MsgBox "Operation Failed"
End If
End If
MsgBox "finished"
End Sub
For coping individual files, Windows does have an equivalent API that will allow you to do what you want. You will probably have to rework this a bit to make it suit your needs, but I would recommend using the CopyFile API. This API will allow you to copy files that are currently in use, and is relatively simple to use. What I have done here is loaded the file names of all the files that I wished to copy into an array, and then just copied each file from the array to the backup file. Of course, you wouldn't have to hardcode the filenames. You could create a dynamic array and use a method of population, but the idea is the same. I tried copying files in use by Word, notepad and Access, and there were not problems, so this might help.
Code:
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" _
(ByVal lpPathName As String, _
lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Private Sub Command1_Click()
Dim FiletoCopy(3) As String
Dim lret As Long
Dim sError As Long
Dim sSecurity As SECURITY_ATTRIBUTES
Dim xTemp As Long
Dim FileName As String
'Add the files to be copied to an array
FiletoCopy(0) = "D:\Documents and Settings\Terry Reese\Desktop\ie2.vbs"
FiletoCopy(1) = "D:\Downloads\hyperlink.zip"
FiletoCopy(2) = "c:\testme.txt"
FiletoCopy(3) = "c:\Dumplog.txt"
'if you try to copy to a directory that doesn't exist,
'you will receive an error. This API call will create
'the directory if it doesn't exist, or return false if
'the directory already exists.
lret = CreateDirectory("c:\testfolder", sSecurity)
For x = 0 To UBound(FiletoCopy)
xTemp = InStrRev(FiletoCopy(x), "\")
FileName = Mid(FiletoCopy(x), xTemp + 1) 'Get the filename
lret = CopyFile(FiletoCopy(0), "c:\testfolder\" & FileName, 0)
Next
MsgBox "Finished"
End Sub
Hope this is more helpful.
-
Thanks a lot reeset, it works! :)
