Option Compare Database
Option Explicit
Function CopiaFichero(RutaOrigen As String, Optional RutaDestino As String) As Boolean
On Error GoTo ControlErrores
'Recibe como parámetros:
'RutaOrigen=Ruta completa + NombreFichero a copiar
'Ej : C:\Mis Documentos\Escrito.doc
'RutaDestino, opcional...sería la ruta a donde copiar el fichero
'EJ: C:\OtraCarpeta\ incluida la barra \ al final
Dim DameNombre As String
DameNombre = InputBox("Introduzca nombre del fichero destino [Incluida extensión]", "Copia de Archivo")
If Len(DameNombre) = 0 Then
CopiaFichero = False
Exit Function
End If
If Len(RutaDestino) = 0 Then
RutaDestino = CurrentProject.Path & "\"
End If
FileCopy RutaOrigen, RutaDestino & DameNombre
CopiaFichero = True
'Por supuesto esto es muy muy muy mejorable, se podría testear si las variables
'pasadas vienen correctamente, si son validas, si las carpetas Origen y destino existen etc etc etc
'pero se trata de dar una ligera idea.
'La he puesto Boolean para saber si el proceso de copia ha tenido éxito
SalFuera:
Exit Function
ControlErrores:
MsgBox Err.Description
CopiaFichero = False
Resume SalFuera
End Function
Function prueba()
'Para probar la funcion.....
If CopiaFichero(CurrentProject.Path & "\bd10.mdb") = True Then
MsgBox "Fichero copiado perfectamente"
Else
MsgBox "Ha habido problemas al copiar"
End If
End Function
               (
geocities.com/es/ensolva/Descargas)                   (
geocities.com/es/ensolva)                   (
geocities.com/es)