'fiz e testei aqui...funcionou....qualquer duvida entre em contato(evertontrv@msn.com) q eu mando p projeto teste q eu fiz aqui....
'coloque um objeto fyle1 e indique os endereços
Public Function Copiar_Todos_Arquivos()
Dim Origem, Destino As String
Origem = "C:TesteOrigem"
Destino = "C:TesteDestino"
File1.Path = Origem
For i = 0 To 1
File1.ListIndex = i
CopyFile Origem & File1.FileName, Destino & File1.FileName
Next
End Function
Public Function CopyFile(Source As String, Destiny As String, Optional BlockSize As Long = 32765) As Boolean
'<EhHeader>
On Error GoTo CopyFile_Err
'</EhHeader>
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
'<EhFooter>
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
'</EhFooter>
End Function
