Que tal gente! Les traigo el codigo creado por BlackZeroX. Esta funcion permite copiar archivos sin ninguna modificacion en el mismo
'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) //
' // //
' // Web: http://InfrAngeluX.Sytes.Net/ //
' // //
' // |-> Pueden Distribuir Este Código siempre y cuando //
' // no se eliminen los créditos originales de este código //
' // No importando que sea modificado/editado o engrandecido //
' // o achicado, si es en base a este código //
' // |-> Si usas el código para algún fin da los Créditos //
' // respectivos así seguiremos liberando Source //
' ////////////////////////////////////////////////////////////////
Option Explicit
Public Function xCopyVBasic(ArchivoOrigen As String, ArchivoDestino As String, Optional CopyAtributes As Boolean = True, Optional ReemplaceFile As Boolean = False) As Long
On Error GoTo ErrorFatal: ' // Ocasiona error este cuando el archivo Origen/Destino este abierto y no pueda Abrir/Crear/Escribir
Dim ff(1) As Integer
Dim Bytes() As Byte
Dim lenBytesFile As Long
Dim ExitsFile(1) As Boolean
Const InvalidByte As Long = -1
xCopyVBasic = InvalidByte ' // Ponemos de una buena ves el valor de error
lenBytesFile = InvalidByte ' // Es un pequeño seguro
ExitsFile(0) = Not Dir(ArchivoOrigen, vbArchive) = ""
ExitsFile(1) = Not Dir(ArchivoDestino, vbArchive) = ""
If ExitsFile(0) Then
ff(0) = FreeFile
Open ArchivoOrigen For Binary As ff(0)
If ReemplaceFile = True And ExitsFile(1) Then
Call SetAttr(ArchivoDestino, vbNormal)
Call Kill(ArchivoDestino)
ExitsFile(1) = Not ExitsFile(1)
End If
If ExitsFile(1) = False Then ' // Se puede quitar este if then pero lo dejo por las dudas (puede ocurrir algo xP).
ff(1) = FreeFile
Open ArchivoDestino For Binary As ff(1)
lenBytesFile = LOF(ff(0)) ' // Hacemos la longitud exacta del archivo en el array
If lenBytesFile > 0 Then
ReDim Bytes(lenBytesFile - 1)
Get ff(0), 1, Bytes()
Put ff(1), 1, Bytes()
Erase Bytes()
End If
xCopyVBasic = lenBytesFile
End If ' // Este se puede quitar siempre y cuando el it then del mismo nivel sea removido.
ErrorFatal:
Close ff(1)
Close ff(0)
If Err.Number = 0 And CopyAtributes And Not lenBytesFile = InvalidByte Then
Call SetAttr(ArchivoDestino, GetAttr(ArchivoOrigen))
End If
End If
End Function
Modo de uso:
'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) //
' // //
' // Web: http://InfrAngeluX.Sytes.Net/ //
' // //
' // |-> Pueden Distribuir Este Código siempre y cuando //
' // no se eliminen los créditos originales de este código //
' // No importando que sea modificado/editado o engrandecido //
' // o achicado, si es en base a este código //
' // |-> Si usas el código para algún fin da los Créditos //
' // respectivos así seguiremos liberando Source //
' ////////////////////////////////////////////////////////////////
Option Explicit
Sub Main()
Const archivo1 As String = "C:\aaa.txt"
Const archivo2 As String = "C:\bbb.txt"
Dim vRes As Long
vRes = xCopyVBasic(archivo1, archivo2, True, True)
MsgBox IIf(Not vRes = -1, "Todo esta bien" & vbCrLf & "Se a copiado un archivo de " & vRes & " Bytes", "a fallado la funcion")
End Sub
Sepan aprovecharlo!!
Saludos! 8)