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