Hi Paul,
Thanks a lot. I am sending you the copy of the code, the function stepone is the main function from which it calls other functions in the module and this function stepone is triggered by a autoexec macro.
Option Compare Database
Option Explicit
Global bkmBookMarkp As String
Global bkmBookMarks As Long
Global bkmBookMarkc As Long
Global Const GblBackEndDBName = "MasDB02132001.mdb"
Dim fpath As String
Public Function fctnLinkTables()
On Error Resume Next
Dim cdb As Database
Dim tbl As tabledef
Dim tbls As TableDefs
Dim flds As Fields
Dim fld As Field
Dim rst As Recordset
Set rst = CurrentDb().OpenRecordset("TblLinkTheseTables", dbOpenTable)
With rst
.MoveFirst
Do Until .EOF
DoCmd.DeleteObject acTable, rst!TableName
DoEvents
DoCmd.TransferDatabase acLink, "Microsoft Access", fpath & GblBackEndDBName, acTable, !TableName, !TableName
.MoveNext
Loop
End With
Set cdb = CurrentDb
Set tbls = cdb.TableDefs
DoCmd.SetWarnings False
Set tbl = CurrentDb.CreateTableDef("TblLinked"
Set flds = tbl.Fields
Set fld = tbl.CreateField("TableName", dbText, 250)
flds.Append fld
tbls.Append tbl
DoEvents
End Function
Public Function XXFindInitialTable()
On Error Resume Next
Dim tbl As tabledef
XXFindInitialTable = False
Set tbl = CurrentDb().TableDefs("TblLinked"
If Err = 0 Then
XXFindInitialTable = True
End If
Set tbl = Nothing
End Function
Function PopulateTable_TblLinkTheseTables()
Dim rst As Recordset
Dim tbl As tabledef
Set rst = CurrentDb.OpenRecordset("TblLinkTheseTables", dbOpenTable)
For Each tbl In CurrentDb.TableDefs
If UCase(Left(tbl.Name, 4)) <> "MSYS" And (tbl.Name <> "TblLinkTheseTables" And tbl.Name <> "TblLinked"
Then
rst.AddNew
rst!TableName = tbl.Name
rst.Update
End If
Next
rst.Close
Set rst = Nothing
Set tbl = Nothing
End Function
Public Function StepOne()
Dim rv As Variant
StepOne = False
If Not XXFindInitialTable() Then
rv = MsgBox("You need to connect to the Back-End prior to using this application. Continue?", vbYesNo, "Connect Application"
If rv = vbNo Then
DoCmd.Quit
End If
rv = InputBox("Please enter the (UNC) complete path to the Back-End Application." & Chr$(13) & Chr$(13) & Chr$(13) & Chr$(13) & "UNC Example: \\<servername>\<share>\", "Enter Path to File", ""
If rv = "" Then
fpath = CurDir
If Right$(fpath, 1) <> "\" Then
fpath = fpath & "\"
End If
rv = Dir(fpath & GblBackEndDBName, vbNormal)
If rv = "" Then
MsgBox "The Back-End Application cannot be found at the location specified.", vbCritical, "Terminating Application"
DoCmd.Quit acQuitSaveNone
Else
End If
End If
Else
StepOne = True
Exit Function
End If
StepOne = True
fpath = rv
rv = fctnLinkTables()
End Function
The code checks whether the user has input a '\' or not if not appends it and it should run fine, but it is not doing.
I am helpless in regard may be there is some problem in the code itself. Thanks a lot.
