为什么我不能以编程方式复制锁定的.mdb但我可以通过资源管理器复制它?

时间:2014-11-13 21:26:51

标签: vba ms-access filesystems access-vba etl

我打算编写一个VBA函数,如果满足某个条件,它将复制.mdb文件。

当我意识到FileCopy方法尝试复制/粘贴的.mdb具有关联的.ldb文件时,我遇到了障碍。

但是,我可以通过Windows资源管理器手动复制/粘贴.mdb

我尝试复制的.mdb将始终被锁定,因为我在运行filecopy过程的数据库中添加了对它的引用。

有人可以告诉我如何使用VBA以编程方式强制复制吗?我试过搜索但是我找到的所有建议都是因为DB损坏等而反对这样做。但这不是一个问题,因为在执行此过程时不会操纵任何DB对象。

如果有人好奇,这是我的程序:

Function fn_ArchiveMonthEndDB()

    'load INI data
    fn_ReadINI

    Dim asOfDate As Date
    asOfDate = getAsOfDate()
    Dim monthEndDate As Date
    monthEndDate = fn_GetMonthEndDate()


    sSQL = "SELECT CDate(Nz(LastRunDate,'1/1/1990')) as BackupDate FROM tbl_UseStats WHERE ProcessName = 'Archive Backend DB'"
    Dim rs As Recordset
    Set rs = CurrentDb.OpenRecordset(sSQL)

    Dim dLastBackup As Date
    dLastBackup = rs!BackupDate

    rs.Close
    Set rs = Nothing

    If (dLastBackup <> monthEndDate) Then

            'determine if it actually is month-end. if yes, then archive the DB.
            If (asOfDate = monthEndDate) Then
                'archive backend DB
                sDir = iBackendArchive & "\" & CStr(Year(monthEndDate)) & CStr(Month(monthEndDate))

                'create dir if it does not exist
                If (Dir(sDir, vbDirectory)) = "" Then
                    MkDir sDir
                End If

                FileCopy iBackendPath & "\ETL_be.mdb", sDir & "\ETL_be.mdb"

            Else
                'if no, do nothing
            End If

    ElseIf (dLastBackup = monthEndDate) Then
        'do nothing, because we already took a backup of the backend DB.
    End If

End Function

1 个答案:

答案 0 :(得分:3)

微软在他们的KB article中解释得非常简单。

<小时/>    - 创建模块并在声明部分中键入以下行:

Option Explicit

Declare Function apiCopyFile Lib "kernel32" Alias "CopyFileA" _
(ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long



   - 键入以下过程:

Sub CopyFile(SourceFile As String, DestFile As String)
'---------------------------------------------------------------
' PURPOSE: Copy a file on disk from one location to another.
' ACCEPTS: The name of the source file and destination file.
' RETURNS: Nothing
'---------------------------------------------------------------
  Dim Result As Long
   If Dir(SourceFile) = "" Then
      MsgBox Chr(34) & SourceFile & Chr(34) & _
         " is not valid file name."
   Else
      Result = apiCopyFile(SourceFile, DestFile, False)
   End If
End Sub



   - 要测试此过程,请在“立即”窗口中键入以下行,然后按Enter:

CopyFile "<path to Northwind.mdb>", "C:\Northwind.mdb"