LinkTable




Function AreTablesAttached () As Integer
' ' Update connection information in attached tables.

' '

' ' Number of attached tables for progress meter.

Const MAXTABLES = 8
Const NONEXISTENT_TABLE = 3011
Const DATA_NOT_FOUND = 3024
Const ACCESS_DENIED = 3051
Const READ_ONLY_DATABASE = 3027
Dim TableCount As Integer
Dim filename As String, SearchPath As String, Temp As String
Dim ReturnValue As Variant, AccDir As String, I As Integer
Dim MyTable As TableDef
Dim MyDB As Database, MyRecords As Recordset
Set MyDB = DBEngine.Workspaces(0).Databases(0)
AreTablesAttached = True
' ' Continue if attachments are broken.

On Error Resume Next
' Open attached table to see if connection information is correct.

Set MyRecords = MyDB.OpenRecordset("FirstAttachedTable")
' ' Exit if connection information is correct.

If Err = 0 Then
MyRecords.Close
Exit Function
End If
' ' Initialize progress meter.

ReturnValue = SysCmd(SYSCMD_INITMETER, "Attaching tables", MAXTABLES)
' ' Get name of directory where MSACCESS.EXE is located.

AccDir = "c:access\" ' Change this accordingly
' ' See if data.mdb is in default location, on c:access\ .

' If not, use as starting place for OpenF

' ile dialog.

Temp = Dir$(AccDir)
SearchPath = AccDir
If (Dir$(SearchPath & "data.mdb") = "") Then
MsgBox "To open data.mdb, the database on the network must be
located and the tables re-attached. Please locate DATA.MDB on the network
on your lettered drive mapped to \\SERVER\DIRECTORY", 48, "Can't find
DATA.MDB"
filename = GetMDBName() ' Display Open File dialog.
filename = Trim(filename)
If filename = "" GoTo Exit_Failed' User pressed Cancel.
Else
filename = SearchPath & "data.mdb"
End If
' Loop through all tables, reattaching those with nonzero-le

' ngth

Connect strings.
TableCount = 1 ' Initialize TableCount for status meter.
For I = 0 To MyDB.TableDefs.Count - 1
Set MyTable = MyDB.TableDefs(I)
If MyTable.Connect "" Then
MyTable.Connect = ";DATABASE=" & filename
Err = 0
MyTable.RefreshLink
If Err 0 Then
If Err = NONEXISTENT_TABLE Then
MsgBox "File '" & filename & "' does not contain required
table '" & MyTable.SourceTableName & "'", 16, "Can't Run APP.MDB"
ElseIf Err = DATA_NOT_FOUND Then
MsgBox "You can't run APP until you locate data.mdb", 16,
"Can't Run APP.MDB"
ElseIf Err = ACCESS_DENIED Then
MsgBox "Couldn't open " & filename & " because it is
read-only or it is located on a read-only share.", 16, "Can't Run APP.MDB"
ElseIf Err = READ_ONLY_DATABASE Then
MsgBox "Can't reattach tables because data.mdb is
read-only or is located on a read-only share.", 16, "Can't Run APP.MDB"
Else
MsgBox Error, 16, "Can't Run APP.MDB"
End If
AreTablesAttached = False
GoTo Exit_Final
End If
TableCount = TableCount + 1
ReturnValue = SysCmd(SYSCMD_UPDATEMETER, TableCount)
End If
Next I
MsgBox "File are re-attached." , 0, "Finished"
GoTo Exit_Final
Exit_Failed:
MsgBox "You can't run APP.MDB until you locate data.mdb", 16, "Can't
Run APP.MDB"
AreTablesAttached = False
Exit_Final:
ReturnValue = SysCmd(SYSCMD_REMOVEMETER)
End Function

Private Function GetMDBName () As String
' Return path of data.mdb chosen by user in OpenFile dialog

' box.

' ' (This function works in conjunction with GetMDBName2 and

StringFromSz to
' display a File-Open dialog that prompts user for location

' of

smartpgm.mdb.
' ' It uses code found in WZLIB.MDA.)

Const OFN_SHAREAWARE = &H4000
Const OFN_PATHMUSTEXIST = &H800
Const OFN_HIDEREADONLY = &H4
Dim OFN As WLIB_GETFILENAMEINFO
' ' Fill ofn structure which is passed to wlib_GetFileName

OFN.hwndOwner = 0
OFN.szFilter = "Databases (*.mdb)|*.mdb|All(*.*)|*.*||"
OFN.nFilterIndex = 1
OFN.szTITLE = "Where is data.mdb?"
OFN.Flags = OFN_SHAREAWARE Or OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY
OFN.szDefExt = "mdb"
' ' Call wlib_GetFileName function and interpret results.

If (GetMDBName2(OFN, True) = False) Then
GetMDBName = StringFromSz(OFN.szFile)
Else
GetMDBName = ""
End If
End Function

Private Function GetMDBName2 (gfni As WLIB_GETFILENAMEINFO, ByVal fOpen As
Integer) As Long
' This function acts as a cover to MSAU_GetFileName in MSAU2

' 00.DLL.

' wlib_GetFileName terminates all strings in gfni structure

' with nulls

and
' ' then calls DLL version of function. Upon returning from

MSAU200.DLL, null
' ' characters are removed from strings in gfni.

Dim lRet As Long
gfni.szFilter = RTrim$(gfni.szFilter) & Chr$(0)
gfni.szCustomFilter = RTrim$(gfni.szCustomFilter) & Chr$(0)
gfni.szFile = RTrim$(gfni.szFile) & Chr$(0)
gfni.szFileTitle = RTrim$(gfni.szFileTitle) & Chr$(0)
gfni.szInitialDir = RTrim$(gfni.szInitialDir) & Chr$(0)
gfni.szTITLE = RTrim$(gfni.szTITLE) & Chr$(0)
gfni.szDefExt = RTrim$(gfni.szDefExt) & Chr$(0)
lRet = wlib_MSAU_GetFileName(gfni, fOpen)
gfni.szFilter = StringFromSz(gfni.szFilter)
gfni.szCustomFilter = StringFromSz(gfni.szCustomFilter)
gfni.szFile = StringFromSz(gfni.szFile)
gfni.szFileTitle = StringFromSz(gfni.szFileTitle)
gfni.szInitialDir = StringFromSz(gfni.szInitialDir)
gfni.szTITLE = StringFromSz(gfni.szTITLE)
gfni.szDefExt = StringFromSz(gfni.szDefExt)
GetMDBName2 = lRet
End Function

Private Function StringFromSz (szTmp As String) As String
' If string terminates with nulls, return a truncated string

' .

Dim ich As Integer
ich = InStr(szTmp, Chr$(0))
If ich Then
StringFromSz = Left$(szTmp, ich - 1)
Else
StringFromSz = szTmp
End If
End Function

The first thing to do is use the CTRL+H option to replace
these words to YOUR applications program name, etc.

APP.MDB to your program DB
data.mdb AND DATA.MDB to your data DB
\\SERVER\DIRECTORY to your UNC, or network path
FirstAttachedTable to a linked table, any one, in your
app.mdb
Once you have replaced all occurrences of the above
Place this in your AUTOEXEC macro as a condition: "Not
AreTablesAttached()", with the macro DoMenuItem
Set the DoMenuItem Properties to:Menu Bar = "Database"
Menu Name = "File", andCommand = "Close Database".
This will run the attachment module on opening.
And, if they do not successfully re-attach the tables
It will tell them to find the location of the data file,
then kick them out of access.
This code assumes that the Wizard utility database wizlib.
mda is specified
in the [Libraries] section of the MSACC20.INI file.










( linktable.html )- by Paolo Puglisi - Modifica del 17/12/2023