我有一个程序,最终目的是从一台膝上型计算机更新服务器支持数据库的所有表格。 一旦完成这项工作,我就希望删除当地(过期)mdb,并将删除的文件(mdb)改为服务器。

看来所有工作都做得很好,但我可以删除当地版本,尽管我把手提电脑前线重新连接到服务器后。 我的守则是:

Call CloseALLFormsReports
  Call RelinkTables("K:ProposalsNorthwayDataNorthway Data.accdb")

 ****************************************** 
   backup current c: database
  tBackupfile = "C:ProposalsackupNorthway DATA" & Format(Now(), "yyyymmdd hhmm") & ".accdb"
  Call TransferBEData("C:ProposalsNorthway DATA.accdb", tBackupfile)
   now overwrite c:drive file
    Call TransferBEData("K:ProposalsNorthwayDataNorthway Data.accdb", "C:ProposalsNorthway DATA.accdb")
    Call RelinkTables("C:ProposalsNorthway 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