不关闭当前数据库COPY当前数据库

Public Const COPY_FILE_FAIL_IF_EXISTS = &H1    '//如果目标文件已存在即退出
Public Const COPY_FILE_RESTARTABLE = &H2       '//拷贝失败的时候可以重新开始
'// 此 API 在 WIN9X 下不能使用
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

'===========================================================
' 过程及函数名：  RunTest
' 版本号      ：  --
' 说明        ：  本过程只用于演示如何用VBA+WINAPI 复制当前
'                 数据库到　c:\a.mdb
' 引用        ：  --
' 输入参数    ：  --
' 输出值      ：  --
' 返回值      ：  --
' 调用演示    ：  RunTest
' 最后修改日期：  2007-12-9 17:36:00

' 作者        ：  cg1
' 网站        ：  http://access911.net
' 电子邮件    ：  access911@gmail.com
' 版权        ：  作者保留一切权力，
'                 请在公布本代码时将本段说明一起公布，谢谢！
'===========================================================
Function RunTest()
    Dim strFileName As String
    strFileName = CurrentProject.FullName
    CopyFileEx strFileName, "c:\a.mdb", 0, Null, False, COPY_FILE_RESTARTABLE
End Function