ACC: Sample Function CopyFile() to Copy Disk FilesID: Q102671
|
Advanced: Requires expert coding, interoperability, and multiuser skills.
Access Basic does not have a command, such as the MS-DOS COPY command,
to copy a disk file.
This article includes two variations of an Access Basic function
called CopyFile(), both of which allow you to copy disk files.
This article assumes that you are familiar with Access Basic and with
creating Microsoft Access applications using the programming tools provided
with Microsoft Access. For more information on Access Basic, please refer
to the "Introduction to Programming" manual in Microsoft Access version
1.x, or the "Building Applications" manual, Chapter 3, "Introducing Access
Basic" in version 2.0.
NOTE: Microsoft Access for Windows 95 can copy files with the new FileCopy
statement. For more information about FileCopy, search for "FileCopy
Statement" using the Microsoft Access for Windows 95 Help Index.
Two variations of the Access Basic CopyFile() function are provided
below. The first version uses only Microsoft Access Basic code; the
second leverages some function calls to the Windows application
programming interface (API) to optimize performance, particularly with
larger files.
NOTE: You may have some Windows API functions defined in an existing
Microsoft Access library; therefore, your declarations may be
duplicates. If you receive the duplicate procedure name error message
when you compile or run your code, remove or comment out the
appropriate declarations statement from your code.
'**************************************************************
' DECLARATION SECTION
'**************************************************************
Option Explicit
'**************************************************************
' FUNCTION: CopyFile()
' PURPOSE:
' Facilitates copying a disk file.
' ARGUMENTS:
' Source - The path\filename of the file to copy from.
' Destination - The path\filename of the file to copy to.
' RETURN:
' The length of the file copied.
'**************************************************************
Function CopyFile (ByVal Source$, ByVal Destination$) As Long
Dim Index1 As Integer, NumBlocks As Integer
Dim FileLength As Long, LeftOver As Long, AmountCopied As Long
Dim SourceFile As Integer, DestFile As Integer
Dim FileData As String
Dim RetVal As Variant
Const BlockSize = 32768
On Error GoTo Err_CopyFile
' Remove the destination file.
DestFile = FreeFile
Open Destination For Output As DestFile
Close DestFile
' Open the source file to read from.
SourceFile = FreeFile
Open Source For Binary Access Read As FreeFile
' Open the destination file to write to.
DestFile = FreeFile
Open Destination For Binary As DestFile
' Get the length of the source file.
FileLength = LOF(SourceFile)
' Calculate the number of blocks in the file and left over.
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize
' Create a buffer for the leftover amount.
FileData = String$(LeftOver, 32)
' Read and write the leftover amount.
Get SourceFile, , FileData
Put DestFile, , FileData
' Create a buffer for a block to be read.
FileData = String$(BlockSize, 32)
' Read and write the remaining blocks of data.
For Index1 = 1 To NumBlocks
' Read and write one block of data.
Get SourceFile, , FileData
Put DestFile, , FileData
Next Index1
Close SourceFile, DestFile
CopyFile = AmountCopied
Bye_CopyFile:
Exit Function
Err_CopyFile:
CopyFile = -1 * Err
Resume Bye_CopyFile
End Function
'****************************************************************
' DECLARATION SECTION
'****************************************************************
Declare Function fWrite Lib "kernel" Alias "_lwrite" (ByVal hFile%, _
ByVal lpBuff&, ByVal nBuff%) As Long
Declare Function fRead Lib "kernel" Alias "_lread" (ByVal hFile%, _
ByVal lpBuff&, ByVal nBuff%) As Long
Declare Function GlobalAlloc Lib "Kernel" (ByVal wFlags%, _
ByVal dwBytes&) As Integer
Declare Function GLobalFree Lib "kernel" (ByVal hMem%) As Long
Declare Function GlobalLock Lib "Kernel" (ByVal hMem%) As Long
Declare Function GLobalUnlock Lib "kernel" (ByVal hMem%) As Long
'****************************************************************
' FUNCTION: CopyFile()
' PURPOSE:
' Facilitates copying a disk file.
' ARGUMENTS:
' Source - The path\filename of the file to copy from.
' Destination - The path\filename of the file to copy to.
' RETURN:
' The length of the file copied, if successful.
'***********************************************************
Function CopyFile (ByVal Source$, ByVal Destination$) As Long
Dim FileLength As Long, AmountCopied As Long
Dim RetVal As Variant, lpBuff As Long
Dim DestFile As Integer, SourceFile As Integer
Dim DestDOS As Integer, SourceDOS As Integer
Dim ApiErr As Integer, AmtRead As Integer
Dim hMem As Integer
Const nBuff = 32767
Const wFlags = &H20
On Error GoTo Err_CopyFile
' Get the size of the file.
SourceFile = FreeFile
Open Source For Binary Access Read As SourceFile
FileLength = LOF(SourceFile)
Close SourceFile
' Allocate and lock memory to buffer file contents.
hMem = GlobalAlloc(wFlags, nBuff)
lpBuff = GlobalLock(hMem)
' Open the source file to read from.
SourceFile = FreeFile
Open Source For Input As SourceFile Len = 1
' Open the destination file to write to.
DestFile = FreeFile
Open Destination For Output As DestFile Len = 1
' Get the operating system file handles.
DestDOS = FileAttr(DestFile, 2)
SourceDOS = FileAttr(SourceFile, 2)
Do
' Read and write nBuff worth of data.
AmtRead = fRead(SourceDOS, ByVal lpBuff, nBuff)
ApiErr = fWrite(DestDOS, ByVal lpBuff, AmtRead)
AmountCopied = AmountCopied + AmtRead
Loop Until AmtRead = 0
Close SourceFile, DestFile
' Unlock and free the file buffer memory.
lpBuff = GLobalUnlock(hMem)
hMem = GLobalFree(hMem)
CopyFile = AmountCopied
Bye_CopyFile:
Exit Function
Err_CopyFile:
CopyFile = -1 * Err
Resume Bye_CopyFile
End Function
Dim RetVal As Long
RetVal = CopyFile("C:\WINDOWS\CHESS.BMP", "C:\CHESS.BMP")
RunCode
Function Name: CopyFile("C:\WINDOWS\CHESS.BMP", "C:\CHESS.BMP") Additional query words: copy files api
Keywords : kbprg PgmFilm
Version : 1.0 1.1 2.0
Platform : WINDOWS
Issue type : kbinfo Last Reviewed: March 25, 1999