是这样,在库的标准模块里,写下如下代码:
Option Compare Database
Option Explicit
Public Paths As String
Dim TheTableName(15) As String, i As Byte
Function TheBiaoName()
TheTableName(1) = "初始系谱表": TheTableName(2) = "登录表": TheTableName(3) = "猪只事件处理记录表"
TheTableName(4) = "配种记录表": TheTableName(5) = "人员档案表": TheTableName(6) = "选项表"
TheTableName(7) = "猪群档案表": TheTableName(8) = "免疫保健程序记录表": TheTableName(9) = "初始库存表"
TheTableName(10) = "单价表": TheTableName(11) = "品名表": TheTableName(12) = "物料药品进出库记录表"
TheTableName(13) = "分娩记录表": TheTableName(14) = "": TheTableName(15) = ""
End Function
Function LinkOrDele(ReadOrWrite As Boolean, pathss As String) As Boolean
On Error GoTo theerr
TheBiaoName
theAddTextBox "正在备份账套，请稍候..."
DoCmd.Hourglass True
If ReadOrWrite = Reading Then
TheTableName(0) = "打开"
FileCopy pathss, Left(pathss, Len(pathss) - 3) & "BAK"
Else
TheTableName(0) = "关闭"
End If
theFirst:
theAddTextBox "正在" & TheTableName(0) & "账套，请稍候... ", , 13
For i = 1 To 13
If ReadOrWrite = Reading Then
DoCmd.DeleteObject acTable, TheTableName(i)
DoCmd.TransferDatabase acLink, "Microsoft Access", pathss, acTable, TheTableName(i), TheTableName(i)
theAddTextBox "", , i
Else
DoCmd.DeleteObject acTable, TheTableName(i)
theAddTextBox "", , i
End If
'DoCmd.RunCommand acCmdWindowArrangeIcons
Next i
LinkOrDele = True
byes:
theAddTextBox
Application.Echo True
DoCmd.Hourglass False
Exit Function
theerr:
Select Case err.Number
Case 7874
Resume Next
Case 70
GoTo theFirst
Case 3011
MsgBox "对不起，此数据库账套不是本软件可以打开的！", vbCritical, strTitle & "打开账套出错！"
LinkOrDele = False
GoTo byes
Case Else
If MsgBox("对不起，这次未能如期打开。是否重试？原因为：" & vbCrLf & err.Number & err.Description, vbYesNo + vbQuestion, strTitle & "打开账套出错！") = vbYes Then
GoTo theFirst
Else
LinkOrDele = False
GoTo byes
End If
End Select
End Function
Function OpenDataBase() As Boolean
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
.Title = "打开"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "数据库账套", "*.mdb"
.ButtonName = "打开账套(&O)"
theAddTextBox "请选择一个数据库账套，或单击“取消”按钮以退出！"
If .Show = -1 Then
Paths = .SelectedItems(1)
Set fd = Nothing
If IsLoaded("主控面板窗体", acForm) = True Then CloseDataBase
OpenDataBase = LinkOrDele(Reading, Paths)
Else
OpenDataBase = False
End If
End With
theAddTextBox
End Function
在启动窗体(Access启动项中设为启动的窗体)中的"打开"按钮的单击事件过程如下:
Private Sub Comm打开_Click()
Me.窗体页脚.Visible = False
If OpenDataBase = True Then
DoCmd.Hourglass False
theFormsOrReportsOpen "登录窗体", , acFormEdit
Else
Me.窗体页脚.Visible = True
End If
End Sub
就在我打开一个库之后,导航窗格就显示出来了.
P.S. theAddTextBox 是我编写的自定义状态栏的函数,可以用来显示进度等.
IsLoaded 是我编写用于判断一个窗体或报表是否在打开状态的函数.
盼望解答ing～
