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. |