Alternative FileCopy - Use to copy opened access databases or to copy a file and make a prog. bar
I made this code because I need to copy an access database with the file open (in use). But, visual basic FileCopy method and windows apis for this pourpose fails in this case with the "File Access Error". So, I made this function that copy the file in blocks. You can alter the block size so the copy can be faster or slower.
Well, thats it. I hope that this code can be useful to anyone!
Ah, the error handle was generated with Ax-Tools CodeSmart 2001, an excelent Add-In for any visual basic programmer! Recommended! :) www.axtools.com
Original Author: Matheus Moreira
Code
Public Function CopyFile(Source As String, Destiny As String, Optional BlockSize As Long = 32765) As Boolean
'
On Error GoTo CopyFile_Err
'
Dim Pos As Long
Dim posicao As Long
Dim pbyte As String
Dim buffer As Long
Dim Exist As String
Dim LenSource As Long
Dim FFSource As Integer, FFDestiny As Integer
100 buffer = BlockSize
102 posicao = 1
104 Exist = ""
106 Exist = Dir$(Destiny)
108 If Exist <> "" Then Kill Destiny
110 FFSource = FreeFile
112 Open Source For Binary As #FFSource
114 FFDestiny = FreeFile
116 Open Destiny For Binary As #FFDestiny
118 LenSource = LOF(FFSource)
120 For Pos = 1 To LenSource Step buffer
122 If Pos + buffer > LenSource Then buffer = (LenSource - Pos) + 1
124 pbyte = Space$(buffer)
126 Get #FFSource, Pos, pbyte
128 Put #FFDestiny, posicao, pbyte
130 posicao = posicao + buffer
'132 RaiseEvent Progress(Round((((Pos / 100) * 100) / (LenSource / 100)), 2))
'134 DoEvents
Next
136 Close #FFSource
138 Close #FFDestiny
'140 RaiseEvent CopyComplete
'
Exit Function
CopyFile_Err:
MsgBox "Um erro inesperado ocorreu!" & vbCrLf & _
"Por favor anote ou copie (Pressionando a tecla 'Print-Screen' e depois CTRL+V no PAINT) os dados abaixo:" & vbCrLf & _
"No Erro: " & Err.Number & vbCrLf & _
"Local: Project1.Form1.CopyFile " & vbCrLf & _
"Linha: " & Erl & vbCrLf & vbCrLf & _
"Descri?º?úo: " & Err.Description & vbCrLf & vbCrLf & _
"Opera?º?úo Cancelada!", vbCritical, "Erro!"
Screen.MousePointer = vbDefault
Resume CopyFile_Sai
CopyFile_Sai:
Exit Function
'
End Function
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.