Dim VectorBytes() As Byte
 
  Open App.Path & "\" & "prueba.dat" For Binary Lock Read As 1
 VectorBytes= Space(LOF(1))
 ' ReDim bytes(?) '<<--- Forma selectiva de bytes Ej. (500)
    Get #1, , VectorBytes
  Close #1

Const FILE_ATTRIBUTE_TEMPORARY = &H100
Const OPEN_EXISTING = 3
Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000
Const FILE_ATTRIBUTE_NORMAL = &H80
Const OPEN_ALWAYS = 4
Const INVALID_HANDLE_VALUE = -1
 
 Private Declare Function FlushFileBuffers Lib "kernel32" ( _
        ByVal hFile As Long) As Long
 
 
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function SetVolumeLabel Lib "kernel32" Alias "SetVolumeLabelA" _
(ByVal lpRootPathName As String, ByVal lpVolumeName As String) As Long
 
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Any, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
 
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Any) As Long
 
 
Private Declare Function WriteFile Lib "kernel32" _
(ByVal hFile As Long, lpBuffer As Any, _
ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As Long, _
ByVal lpOverlapped As Any) As Long
 
Private Sub Command1_Click()
    Dim hFile As Long
    Dim fBytes() As Byte <==Array del archivo
    Dim fSize As Long, lBytesRead As Long
    Dim fSuccess As Long
    Dim BytesToRead As Long
    Dim FileToRead As String
 
   FileToRead = App.Path & "\" & "Prueba.dat"
 
 
    '///LEE EL ARCHIVO EN BYTES ///////////////////
    hFile = CreateFile(FileToRead, _
    GENERIC_WRITE Or GENERIC_READ, 0&, 0&, _
    OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0&)
    If hFile <> INVALID_HANDLE_VALUE Then
    fSize = GetFileSize(hFile, 0)
    ReDim fBytes(fSize)
    BytesToRead = (UBound(fBytes) + 1) * LenB(fBytes(0))
    fSuccess = ReadFile(hFile, fBytes(LBound(fBytes)), BytesToRead, lBytesRead, 0&)
    CloseHandle hFile
     End If
    '/////////////////////////////////////////////
 
 
 
 ' Guardar el archivo en otro directorio (Con API)
  Call CrearAchivoBinario("C:\PruebaCopia.dat", fBytes)
 
 
 
 '///guardar el archivo en otro directorio (Sin API)
    'Open "C:\PruebaCopia.dat" For Binary Access Write As 1
    'Put #1, , fBytes
    'Close
End Sub
 
 
   Private Sub CrearAchivoBinario(ByVal FileName As String, fBytes() As Byte)
    Dim fSuccess As Long
    Dim hFile As Long
    Dim BytesToRead As Long
    Dim lBytesWritten As Long
 
       BytesToWrite = (UBound(fBytes) + 1) * LenB(fBytes(1))
          hFile = CreateFile(FileName, _
          GENERIC_WRITE Or GENERIC_READ, _
          ByVal 0&, ByVal 0&, _
          OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0&)
 
            If hFile <> INVALID_HANDLE_VALUE Then
          fSuccess = WriteFile(hFile, fBytes(LBound(fBytes)), BytesToWrite, lBytesWritten, 0&)
 
            If fSuccess <> 0 Then
               fSuccess = FlushFileBuffers(hFile)
               fSuccess = CloseHandle(hFile)
            End If
            End If
 
      End Sub