** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Tus Funciones Favoritas & Aportaciones & Artí­culos
  Mensajes nuevos Mensajes nuevos RSS - Duplicar fichero(Simular copiar y pegar)
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoDuplicar fichero(Simular copiar y pegar)

 Responder Responder
Autor
Mensaje
buho Ver desplegable
Administrador
Administrador
Avatar
Abuelo FELIZ, nieto desesperado

Unido: 10/Abril/2004
Localización: Valladolid
Estado: Sin conexión
Puntos: 11321
Enlace directo a este mensaje Tema: Duplicar fichero(Simular copiar y pegar)
    Enviado: 17/Agosto/2013 a las 09:29
Otro código que deseo quede recogido aqui en el historico de tus funciones favoritas.
Es como simular un copy-paste de un fichero.
Sé que esto se puede hacer mucho mas facil con una sencilla API que copie ficheros (Abiertos o cerrados)  o bien, simplemente, con la nativa de VBA Filecopy.
Lo pongo, ya que la forma de «copiar» el fichero origen es distinta, más original y.... es abrir el fichero y leer su contenido binario, para luego, si queremos (Caso de este ejemplo) volcarle en otro fichero y clonar el primero.
Insisto, esto lo hace FileCopy sin más...pero...con este sencillo método que pongo aquí a continuación, podemos tener en una variable/matriz tipo Byte el contenido integro del fichero y por ejemplo, guardar su contenido en el campo de una tabla, almacenarlo y volverle a reproducir de nuevo en disco cuando deseemos.
En fin...ahí queda el código por si sirve a alguien.

Sub CopiaPega(NombreFicheroOrigen As String, _
    NombreFicheroFinal As String)
    Dim B() As Byte, StrLongitud&
    StrLongitud = FileLen(NombreFicheroOrigen)
    ReDim B(StrLongitud - 1)
    Open NombreFicheroOrigen For Binary Access Read As #1
    Get #1, , B
   'en B tengo INTEGRO el fichero original
   'Podría meterle en el campo memo de una tabla etc etc
   'En este caso y por simplicidad, vuelco el cotenido a un nuevo
   'fichero en disco, clon del primero

    Open NombreFicheroFinal For Binary Access Write As #2
    Put #2, , B
   
End Sub

Sub ProbandoCodigo()
 CopiaPega CurrentProject.Path & "\FicheroOriginal.doc", _
     CurrentProject.Path & "\FicheroCopia.doc"
End Sub
Por fin he hecho algo bueno, ser abuelo ¡y porque no lo he hecho yo!
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable