I'm almost done with an application, and trying to lock it down
tightly. But I still want users to be able to point to a new location
for the data file.
The code below fires off to detect and address the problem of a
moved/renamed data file. The problem: WITHOUT the "tdf.Attributes =
dbHiddenObject" line, my previously hidden tables are now visible.
(Not that the users will normally have the chance to see them, hidden
or not.)
WITH the "tdf.Attributes = dbHiddenObject" code, the tables are
bloody well hidden! Can't see them even if "show hidden objects"
is on.
Any ideas? If so, please be specific about how to deal with
Attributes. They are still a bit mysterious to me.
P. Emigh
--------------------------------------------
Public Function fOpenMain()
Dim dbs As Database
Dim tdf As TableDef
Dim strPath As String
On Error Resume Next
DoCmd.OpenForm "fmnuSwitchboard"
If Err = 3043 Or Err = 3024 Or Err = 3044 Then
If MsgBox("Data file note found, likely because it was moved or
renamed. Would you like to re-link data?" & vbCrLf & vbCrLf & "CAUTION:
Failing to do this correctly could cause data corruption!" & vbCrLf &
vbCrLf & "If you choose NO, you'll have another chance to link to the
data file next time you open the database.", vbYesNo) = vbYes Then
Err = 0
strPath = InputBox("Path and name of data file:" & vbCrLf &
vbCrLf & "Your response might look something like
'\\MainComputerName\CashSheet\CashSheetData.mdb'")
Set dbs = CurrentDb
For Each tdf In dbs.TableDefs
' Re-set links to all the linked tables
If tdf.connect <"" Then
tdf.connect = ";DATABASE=" & strPath
tdf.RefreshLink
End If
tdf.Attributes = dbHiddenObject
Next tdf
dbs.Close
If Err = 0 Then
MsgBox "Links created successfully. The database will
close now. Re-open it, and then you should be able to proceed with
your work."
Application.Quit
Else
MsgBox "There was apparently an error in trying to link
to the server data at " & vbCrLf & strPath & vbCrLf & "Error: " & Err &
" " & Err.Description
End If
Else
MsgBox "The database will close now."
Application.Quit
End If
End If
If Err <0 Then
MsgBox Err & " " & Err.Description
DoCmd.OpenForm "fpopPW"
End If
End Function
