'Adaptacion de una Rutina de la API Guide
'Buho Enero 2002
'Proposito:
'Copiar la propia MDB que ejecuta este codigo, sin producir
'el error de <fichero abierto>

'Esto ene un modulo
Option Compare Database
Public Const PROGRESS_CANCEL = 1
Public Const PROGRESS_CONTINUE = 0
Public Const PROGRESS_QUIET = 3
Public Const PROGRESS_STOP = 2
Public Const COPY_FILE_FAIL_IF_EXISTS = &H1
Public Const COPY_FILE_RESTARTABLE = &H2
Public Declare Function CopyFileEx Lib "kernel32.dll" Alias "CopyFileExA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal lpProgressRoutine As Long, lpData As Any, ByRef pbCancel As Long, ByVal dwCopyFlags As Long) As Long
Public bCancel As Long

Public Function CopyProgressRoutine(ByVal TotalFileSize As Currency, ByVal TotalBytesTransferred As Currency, ByVal StreamSize As Currency, ByVal StreamBytesTransferred As Currency, ByVal dwStreamNumber As Long, ByVal dwCallbackReason As Long, ByVal hSourceFile As Long, ByVal hDestinationFile As Long, ByVal lpData As Long) As Long
  CopyProgressRoutine = PROGRESS_CONTINUE
End Function


'Esto en cualquier parte de tu MDB que quieras
Private Sub CopiaEstaBase()
 Dim Ret As Long
 Ret = CopyFileEx(CurrentDb.Name, CurrentProject.Path & "\nuevonombre.mdb", AddressOf CopyProgressRoutine, ByVal 0&, bCancel, COPY_FILE_RESTARTABLE)
End Sub