Hola, no se si alguien mas habra usado esta rutina para copiar un mdb.
Supongo que Buho podra responderme pues fue el quien me la paso.
El caso es que funciona a la perfección en w2k, pero cuando llevo el
programa al cliente con w98, no me copia el fichero, solo me crea el
directorio nuevo. Cual puede ser el problema???

Adjunto el codigo con las modifcaciones que necesite hacer (en cuanto a
nombres y ubicaciones).

Saludos,
Manuel Suarez

*** Codigo pasado amablemente por Buho ***
Option Compare Database
Option Explicit

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

'Esto ene un modulo
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

Public Function CopyMDB(tipo As String)
Dim path, newpath As String
Dim fec As Date
Dim val, rect
'1º  crear directorio para la copia de seguridad
path = left(Mid(CurrentDb.TableDefs("tbl_alb_mae").Connect, 11),
Len(Mid(CurrentDb.TableDefs("tbl_alb_mae").Connect, 11)) - 17)
If Dir(path & "respaldo", vbDirectory) = "" Then
  MkDir (path & "respaldo")
End If

fec = Now()
newpath = Format(fec, "dd-mm-yyyy") & "_" & Format(fec, "hh-mm")
If tipo = "INF47" Then
  newpath = "INF47_" & newpath
End If
MkDir (path & "respaldo\" & newpath)
'linea que lanza la copia
rect = CopyFileEx(path & "base de datos.mdb", path & "respaldo\" & newpath &
"\" & "base de datos.mdb", AddressOf CopyProgressRoutine, ByVal 0&, bCancel,
COPY_FILE_RESTARTABLE)
End Function


Responde Buho
=============

Hola.
Pues que dicha funcion solo sirve para S.O con nucleo NT. Es decir WIn NT,
2000, XP etc

Utiliza esta otra:

Private Declare Function CopiaFichero Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Sub Prueba98()
    CopiaFichero CurrentDb.Name, "C:\" + "borra.mdb", 0
End Sub

Si el fichero no estuviera abierto, utiliza la nativa deVBA, FileCopy