Question

我有一个程序，其最终目标是从笔记本电脑更新服务器后端数据库上的所有表。完成后，我想删除本地（笔记本电脑）mdb并将已删除的文件（mdb）替换为服务器mdb。

除非我将笔记本电脑前端重新连接到服务器后端，否则我无法删除本地版本。这是我的代码：

Call CloseALLFormsReports
  Call RelinkTables("K:\Proposals\Northway\Data\Northway Data.accdb")

 ****************************************** 
  'backup current c: database
  tBackupfile = "C:\Proposals\backup\Northway DATA" & Format(Now(), "yyyymmdd hhmm") & ".accdb"
  Call TransferBEData("C:\Proposals\Northway DATA.accdb", tBackupfile)
  'now overwrite c:drive file
    Call TransferBEData("K:\Proposals\Northway\Data\Northway Data.accdb", "C:\Proposals\Northway DATA.accdb")
    Call RelinkTables("C:\Proposals\Northway DATA.accdb")

*************HERE IS THE TransferBEDate function:
Function TransferBEData(ByVal tSource As String, ByVal tDestination As String)

If FileExists(tDestination) Then
  Kill tDestination
End If

FileCopy tSource, tDestination

End Function

************HERE IS MY Relinking Function
Public Sub RelinkTables(strNewPath As String)

Dim dbs As DAO.Database
Dim tdf As TableDef
Dim intCount As Integer
Dim frmCurrentForm As Form
Dim relink As Boolean

DoCmd.Hourglass True
On Error GoTo ErrLinkUpExit
'Me.lblMsg.Visible = True
'Me.cmdOK.Enabled = False

Set dbs = CurrentDb

For intCount = 0 To dbs.TableDefs.Count - 1
Set tdf = dbs.TableDefs(intCount)
If tdf.Connect <> "" Then
'Me.lblMsg.Caption = "Refreshing " & tdf.Name
DoEvents
tdf.Connect = ";DATABASE=" & strNewPath
tdf.RefreshLink
End If ' tdf.Connect <> ""
Next intCount

Set dbs = Nothing
Set tdf = Nothing

DoCmd.Hourglass False
 MsgBox ("The file:  " & strNewPath & " was successfully linked.")
'Me.lblMsg.Caption = "All Links were refreshed!"
relink = True
'Me.cmdOK.Enabled = True
Exit Sub

ErrLinkUpExit:
DoCmd.Hourglass False

Select Case Err
Case 3031 ' Password Protected
 MsgBox "Back End '" & strNewPath & "'" & " is password protected"
Case 3011 ' Table missing
DoCmd.Hourglass False
 MsgBox "Back End does not contain required table '" & _
  tdf.SourceTableName & "'"
Case 3024 ' Back End not found
 MsgBox "Back End Database '" & strNewPath & "'" & " " & _
  "Not Found"
Case 3051 ' Access Denied
 MsgBox "Access to '" & strNewPath & "' Denied " & _
 vbCrLf & _
 " May be Network Security or Read Only Database"
Case 3027 ' Read Only
 MsgBox "Back End '" & strNewPath & "'" & " is Read " & _
 "Only "
Case 3044 ' Invalid Path
 MsgBox strNewPath & " Is Not a Valid Path"
Case 3265
 MsgBox "Table '" & tdf.Name & "'" & _
 " Not Found in ' " & strNewPath & "'"
Case 3321 ' Nothing Entered
 MsgBox "No Database Name Entered"
Case Else
 MsgBox "Uncaptured Error " & Str(Err) & " " & _
 Err.Description
End Select

Set tdf = Nothing
relink = False

'******************Get rid of blank records
DoCmd.SetWarnings False
DoCmd.OpenQuery "Delete_Blank_Material_Records"
DoCmd.SetWarnings True
'********************************************

End Sub

Function TransferBEData(ByVal tSource As String, ByVal tDestination As String)

If FileExists(tDestination) Then
  Kill tDestination
End If

FileCopy tSource, tDestination

End Function

Answer 1

这不起作用的原因是因为将表重新链接到另一个源不会从.mdw锁文件中删除该条目（或者在03以后的版本中删除相同的安全性）。您需要关闭前端数据库，然后重新打开才能解锁本地.mdb文件。

重新链接到新的mdb然后删除旧数据库（mdb）

1 个答案: