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