|
The sample code below provides a method for copying an open file using either Microsoft Access or Visual Basic 5 or 6. With minor changes this will also work in VB.Net
Option Explicit
Public Event ProgressIndicator(ByVal PercentComplete As Single, ByRef Cancel As Boolean)
Public BufferSize As Long
Enum FileCopyResponses
ERROR_SUCCESS = -1
ERROR_FILE_NOT_FOUND = 1
ERROR_FILE_ALREADY_EXISTS = 2
ERROR_OTHER_ERROR = 2 ^ 31 - 1
End Enum
Public Function OpenFileCopy(ByVal SourceFile As String, ByVal DestinationFile As String) As FileCopyResponses
Dim lSource As Integer
Dim lDest As Integer
Dim sBuf As String
Dim lLength As Long
Dim lCount As Long
Dim CancelCopy As Boolean
On Error Resume Next
If BufferSize = 0 Then
BufferSize = 1024
End If
If Dir(SourceFile) = "" Then
OpenFileCopy = ERROR_FILE_NOT_FOUND
Exit Function
End If
If Dir(DestinationFile) <> "" Then
OpenFileCopy = ERROR_FILE_ALREADY_EXISTS
Exit Function
End If
lSource = FreeFile
Open SourceFile For Binary As lSource
lDest = FreeFile
Open DestinationFile For Binary As lDest
lLength = LOF(lSource)
If lLength > BufferSize Then
sBuf = String(BufferSize, 0)
Else
sBuf = String(lLength, 0)
End If
Do
Get lSource, , sBuf
Put lDest, , sBuf
lCount = lCount + Len(sBuf)
If lLength - lCount > 0 Then
If lLength - lCount > BufferSize Then
sBuf = String(BufferSize, 0)
Else
sBuf = String(lLength - lCount, 0)
End If
End If
RaiseEvent ProgressIndicator(lCount / lLength, CancelCopy)
If CancelCopy = True Then
Exit Do
End If
DoEvents
Loop Until lLength - lCount <= 0
Close lSource
Close lDest
If CancelCopy = True Then
Kill DestinationFile
End If
If Err.Number = 0 Then
OpenFileCopy = ERROR_SUCCESS
Else
OpenFileCopy = ERROR_OTHER_ERROR
End If
End Function
The sample code below is a command-line utility that uses the class above to copy open files.
Option Explicit
Sub Main()
Dim FS As New MVFS.MVFileSystem
Dim lRet As MVFS.FileCopyResponses
Dim src As String
Dim dest As String
If Command$ <> "" Then
If InStr(Command$, " ") > 0 Then
src = Left(Command$, InStr(Command$, " ") - 1)
dest = Right(Command$, Len(Command$) - (InStr(Command$, " ")))
If Dir(src) <> "" Then
If src = dest Then
VBA.MsgBox "Source and Destination are the same"
Else
If Dir(dest) <> "" Then
VBA.MsgBox "Destination already exists"
Else
lRet = FS.OpenFileCopy(src, dest)
If lRet <> ERROR_SUCCESS Then
If lRet = ERROR_FILE_ALREADY_EXISTS Then
VBA.MsgBox "Destination already exits"
End If
If lRet = ERROR_FILE_NOT_FOUND Then
VBA.MsgBox "Source not found"
End If
If lRet = ERROR_OTHER_ERROR Then
VBA.MsgBox "unknown error occurred"
End If
End If
End If
End If
Else
VBA.MsgBox "Cannot find " & src
End If
Else
VBA.MsgBox "Usage is: OFCopy [file1] [file2] where [file1] is the source file, and [file2] is the destination."
End If
End If
End Sub
The source for this project can be downloaded from: http://www.mvct.com/OpenFileCopyProject.zip
By downloading, copying, or using this code, you agree to use it solely at your own risk. I provide no warranty express or implied for this code.
I can be reached via email to mvernon@mvct.ca. If I don't reply it's because either my spam filter took care of you, or I'm really busy. Either way, please accept my apologies in advance.
|
