[VB] xCopyVBasic (Funcion Copiar archivo)

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!