Create a link to a file.

[Guest]

I have two sets of databases: Production and Test. Production is on the
server and the Test data is on my c:\ drive.

The Problem: Linking the tables.
Right now I am using the table link manager to change the links.

The Solution: My ideal solution is to have two function. One that changes
all the linked files to my test data. the other function links all the files
to the production data. I am thinking something like this:

function testdata()
remove all links
link c:\testdata\test.mdb , table ("orders")
link c:\testdata\test.mdb , table ("order details")
link c:\testdata\maginfo.mdb , table ("maginfo")
ect.
ect.
ect.
end function

Of course there will be the other function to set the links back to the
production tables.
Does anyone have a good simple way of doing this?
I am wide open for suggestions.
Scott.

 

[Alex Dybenko]

Hi,
you can build something based on this:
http://www.mvps.org/access/tables/tbl0009.htm

 

[Guest]

Below is the code for a form that will accomplish what you want. There is
some irrelevant code, but you can delete it. Some of the code is not up to
my personal standard, but I did not do the original version, I just expanded
it to make it easier to use.

You will have to create a form and add the controls you need to make this
happen.
First, you will need the two API modules referenced in the sites below.

API Code for common dialog
http://www.mvps.org/access/api/api0001.htm

API Code for UNC path
http://www.mvps.org/access/api/api0003.htm

Form Module Code

Option Compare Database
Option Explicit

Dim UseDirName As String

Function OkToLink() As Boolean
OkToLink = Not IsNull(Me.datapath) And Not IsNull(Me.localpath)
End Function

Function NewDatabasePath(strDbType) As String
Dim varGetFileName As Variant 'Pass to Common Dialog to open workbook
Dim strDefaultDir As String 'Pass Directory to search for common dialog
Dim strfilter As String 'Limit common dialog search to excel workbooks
Dim lngFlags As Long 'Hide readonly check box on common dialog
Dim strFileName As String 'Initial File Name to Display
Dim strDialog As String

strDialog = "Select " & strDbType & " Database"
'Flags Hides the Read Only Check and Only allow existing files
lngFlags = ahtOFN_HIDEREADONLY Or ahtOFN_FILEMUSTEXIST
'Set filter to show only Access Databases
strfilter = ahtAddFilterItem(strfilter, "Access (*.mdb,*.mde)",
"*.MDB;*.MDA")
'Call the Open File Dialog
Do While True
varGetFileName = ahtCommonFileOpenSave( _
OpenFile:=True, _
Filter:=strfilter, _
Flags:=lngFlags, _
DialogTitle:=strDialog)
If varGetFileName = "" Then 'User Clicked CANCEL
If MsgBox("Retry to select a Database " & vbNewLine & "Or" _
& vbNewLine & "Cancel to Quit", vbExclamation +
vbRetryCancel, _
"No Database Selected") = vbCancel Then
Exit Do
End If
Else
Exit Do
End If
Loop
NewDatabasePath = varGetFileName

End Function

Private Sub btnDATA_Click()
Dim st As String
Dim Msg As String
Dim strPath As String

strPath = NewDatabasePath("CISCMSDATA")
If strPath = "" Then
DoCmd.Close acForm, Me.Name, acSaveNo
Else
If Left(strPath, 1) < "E" Then
Me.datapath = strPath
Else
Me.datapath = fGetUNCPath(Left(strPath, 2)) & Right(strPath,
Len(strPath) - 2)
End If
Me.cmdChangeLinks.Enabled = OkToLink
End If
End Sub

Private Sub btnLOCAL_Click()
Dim st As String
Dim Msg As String
Dim strPath As String

strPath = NewDatabasePath("LOCALDATA")
If strPath = "" Then
DoCmd.Close acForm, Me.Name, acSaveNo
Else
If Left(strPath, 1) < "E" Then
Me.localpath = strPath
Else
Me.localpath = fGetUNCPath(Left(strPath, 2)) & Right(strPath,
Len(strPath) - 2)
End If
Me.cmdChangeLinks.Enabled = OkToLink
End If
End Sub


Private Sub cmdChangeLinks_Click()
' Relink all NGCMSdata.mdb, and SharedData as specified by the user.
' (offbook.mdb is assumed to always be in the "\\iispi02\ngcms ...
\shareddata\" folder.)

Dim DataCnt As Integer
Dim datafile As Integer
Dim dbs As Database
Dim intcount As Integer
Dim LocalCnt As Integer
Dim localfile As Integer
Dim Response As Variant
Dim tdf As TableDef

Set dbs = CurrentDb()
On Error GoTo linkerror

' Be sure the user has specified all fields!
If Len(Nz(Me.datapath)) = 0 Or Len(Nz(Me.localpath)) = 0 Then
MsgBox "You must specify all the linkage paths on the form before I can
relink!", vbExclamation, "Specify linkage paths."
Exit Sub
End If

DataCnt = 0
LocalCnt = 0
'MsgBox "This will take several minutes, don't mess with anything til it
says 'files relinked'"
DoCmd.Hourglass (True)

intcount = 0
Response = SysCmd(acSysCmdInitMeter, "Relinking Tables - Please Wait ",
dbs.TableDefs.Count - 1)

For Each tdf In dbs.TableDefs
intcount = intcount + 1
Response = SysCmd(acSysCmdUpdateMeter, intcount)

If Len(tdf.Connect) > 0 Then
' Its a linked table. Re-link

datafile = InStr(1, tdf.Connect, "CISCMSdata")
localfile = InStr(1, tdf.Connect, "LocalData")

If localfile > 0 Then
tdf.Connect = ";database=" & Me.localpath
tdf.RefreshLink
LocalCnt = LocalCnt + 1

ElseIf datafile > 0 Then
tdf.Connect = ";database=" & Me.datapath
tdf.RefreshLink
DataCnt = DataCnt + 1

End If
Else
' Not a connected table; don't do anything.
End If
Next tdf
DoCmd.Hourglass (False)
Response = SysCmd(acSysCmdRemoveMeter)
MsgBox "Files relinked! " & vbCr & DataCnt & " data files and " & LocalCnt
& " local Files were relinked"
Exit Sub

linkerror:
MsgBox "error in relinking " & tdf.Name & " " & Err.Description
DoCmd.Hourglass (False)
Response = SysCmd(acSysCmdRemoveMeter)
End Sub

Private Sub cmdlink_Click()

' NOTE: This sub does not work.
Exit Sub ' ...until it is fixed or deleted.

Dim dbs As Database
Dim intcount As Integer
Dim tdf As TableDef
Dim str As String
Dim datafile As Integer
Dim localfile As Integer
Set dbs = CurrentDb()
On Error GoTo ErrorHandler

For intcount = 0 To dbs.TableDefs.Count - 1
Set tdf = dbs.TableDefs(intcount)

If Len(tdf.Connect) > 0 Then
' Its a linked table
str = tdf.Connect
datafile = InStr(1, tdf.Connect, "data.mdb")
localfile = InStr(1, tdf.Connect, "localdata")
If localfile > 0 Then
tdf.Connect = Me.localpath
ElseIf datafile > 0 Then
tdf.Connect = Me.datapath
' MsgBox " tdf.connect is " & tdf.connect
' Err = 0
' On Error Resume Next

MsgBox intcount & tdf.Name
tdf.RefreshLink

End If
Else
End If
Next intcount


MsgBox "files relinked!"
Exit Sub
ErrorHandler:
MsgBox "There was an error in linking the files"
End Sub

Private Sub Command23_Click()
On Error GoTo Err_Command23_Click
DoCmd.Close

Exit_Command23_Click:
Exit Sub

Err_Command23_Click:
MsgBox Err.Description
Resume Exit_Command23_Click

End Sub

Private Sub LockOutUsers_Click()
Dim db As Database
Dim rst As Recordset
Set db = CurrentDb()

Set rst = db.OpenRecordset("tblsettings", dbOpenDynaset)

rst.Edit
rst("logoff") = True
rst.Update
MsgBox "All users will be logged out of NGCMS and the system will be shut
down"

End Sub
Private Sub cmdUpdateContact_Click()
On Error GoTo Err_cmdUpdateContact_Click

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "frmContactUpdates"
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_cmdUpdateContact_Click:
Exit Sub

Err_cmdUpdateContact_Click:
MsgBox Err.Description
Resume Exit_cmdUpdateContact_Click

End Sub
*********End Code

 

[Guest]

Hi Alex, Thank you for the link. It looks good but a bit to fancy for what
I need.

I am looking to change the link with a singual line of code.
I know, I know, This is Access, Simple is not allowed! I will take
"Simple as Possible".

Lets focus on changing the link on one table.

 

[Guest]

Not gonna happen with one line of code.

("I want to add a room to my house, but I only want to use one nail")

 

[Guest]

Ok... I found code in the help file and took out all the unneeded stuff.
and this is what I came up with. The orginial code came from the help file.
"Connect and SourcetableName Properties Example (DAO).

The error comes from the line: DBSTEMP.TableDefs.Append tdfLinked
the error is :
Run time Error
Could not find Installable ISAM.

What ISAM. The help file did not mention any ISAM.?????


Function linkmelist()
Rem JetTable = Access table
Call linkme3("JetTable", "C:\CLEARWIN\HISTORICALBACKEND.MDB", "COMMENT1")
End Function

Function linkme3(strtable As String, strConnect As String, strSourceTable As
String)
Dim DBSTEMP As Database
Dim tdfLinked As TableDef
Dim rstLinked As Recordset
Dim intTemp As Integer

Set DBSTEMP = CurrentDb()

' Create a new TableDef, set its Connect and
' SourceTableName properties based on the passed
' arguments, and append it to the TableDefs collection.
Set tdfLinked = DBSTEMP.CreateTableDef(strtable)

tdfLinked.Connect = strConnect
tdfLinked.SourceTableName = strSourceTable
DBSTEMP.TableDefs.Append tdfLinked

Set rstLinked = DBSTEMP.OpenRecordset(strtable)

' Delete the linked table because this is a demonstration.
Rem dbsTemp.TableDefs.Delete strTable

End Function

 

[Guest]

Sorry, Scott, I really don't know what that is trying to do.

 

[Guest]

Ok.... I have two sets of databases. The production database that are on
the server. This is the live data. I also have a copy of the production
database on my c: drive. This is the testing database.

Right now I use the link manager to change the links form the Production
databases to the testing database. and back again.

this is a slow process. My thinking is this. What if I had a macro run a
funtion. This function will relink the linked tables quickly and easily. I
would like to have a function like this:

Function linkmelist()
Rem JetTable = Access table
Call linkme3 ("JetTable", "C:\CLEARWIN\HISTORICALBACKEND.MDB", "COMMENT1")
Call linkme3 ("JetTable","C:\CLEARWIN\ORDERENTRYBACKEND.MDB","ORDERS")
Call Linkme3
("JetTable","C:\CLEARWIN\ORDERENTRYBACKEND.MDB","ORD_DETAILS")
Call Linkme3 ("JetTable","C:\CLEARWIN\ACCOUNT.MDB","OPENORDER")
End Function

I would use one function to link the program to the test databases and
another to link the program to the live databases.

Keep in mind that the most programs have 17 - 24 linked tables spread over 7
or more MDB's.

Now I looked at the examples and I came up with this:
Function linkme3(strtable As String, strConnect As String, strSourceTable As
String)
Dim DBSTEMP As Database
Dim tdfLinked As TableDef
Dim rstLinked As Recordset
Dim intTemp As Integer

Set DBSTEMP = CurrentDb()

' Create a new TableDef, set its Connect and
' SourceTableName properties based on the passed
' arguments, and append it to the TableDefs collection.
Set tdfLinked = DBSTEMP.CreateTableDef(strtable)

tdfLinked.Connect = strConnect
tdfLinked.SourceTableName = strSourceTable
DBSTEMP.TableDefs.Append tdfLinked

Set rstLinked = DBSTEMP.OpenRecordset(strtable)

' Delete the linked table because this is a demonstration.
Rem dbsTemp.TableDefs.Delete strTable

End Function

But..... This function gives me an error on the line:
DBSTEMP.TableDefs.Append tdfLinked
the Error says:
Run time Error
Could not find Installable ISAM.

can someone explain why my LinkMe3() function does not work?
Do you have a better LinkMe3() function?

 

[Guest]

Scott,
The code you have posted looks like it is trying to create new tables and
then link them. From what you have said, I don't think that is what you are
trying to do.
I know what I sent you previously looks like a lot of stuff, but if you take
the time to put it together and modify it for you needs, it is very easy to
use.
If you find the loop in the code that actually does the relinks, you could
use just that part and hard code the paths in it that you want and run that
from a macro.

 

[Guest]

Scott,
The code you have posted looks like it is trying to create new tables and
then link them. From what you have said, I don't think that is what you are
trying to do.
I know what I sent you previously looks like a lot of stuff, but if you take
the time to put it together and modify it for you needs, it is very easy to
use.
If you find the loop in the code that actually does the relinks, you could
use just that part and hard code the paths in it that you want and run that
from a macro.

 

[Guest]

This is what I distilled from your code sample.

Function linkmelive()
Rem link table to live database.
Call linkme("T:\INTERCONTINENTAL\HISTORICALBACKEND.MDB", "COMMNET1")
End Function

Function linkme(strDatabase As String, strNewTable As String)
Dim DBS As Database
Dim TDF As TableDef

Set DBS = CurrentDb()

For Each TDF In DBS.TableDefs
Rem use only the linked tables
If Len(TDF.Connect) > 0 Then
Rem this is a linked table

Rem if this is the name of the table.
Rem then change the database location.
If TDF.NAME = strNewTable Then
TDF.Connect = ";database=" & strDatabase
TDF.RefreshLink
End If

Else
Rem not a connected table
End If
Next TDF

Rem cleanup
Set TDF = Nothing
Set DBS = Nothing

End Function

Everything seems to be working the way I wont it but this:
If TDF.NAME = strNewTable Then
Even tho both TDF.NAME and strNewTable = "COMMNET1" It does not regester
as true.

why does {If TDF.NAME = strNewTable Then} not regester as a ture statment?

 

[Douglas J. Steele]

Everything seems to be working the way I wont it but this:
If TDF.NAME = strNewTable Then
Even tho both TDF.NAME and strNewTable = "COMMNET1" It does not regester
as true.

why does {If TDF.NAME = strNewTable Then} not regester as a ture statment?

What Option Compare value do you have at the start of the module? If it's
Option Compare Binary, then if the two bits of text you're comparing text
have different cases, they will not be treated as equal. If it's Option
Compare Database, it depends on the LocaleId of the database.

Try

If StrComp(TDF.NAME, strNewTable, 1) = 0 Then

 

[Guest]

Are you trying to link a tabke that has not been linked before? If so, it
would have no connect string and would be bypassed at:
If Len(TDF.Connect) > 0 Then

That would be the only thing that explains it.

If this is, in fact, what you are trying to do, then all you really need is:

Function linkme(strDatabase As String, strNewTable As String)
Dim tdf As TableDef

Set tdf = CurrentDb.TableDefs(strNewTable)
With tdf
.Connect = ";database=" & strDatabase
.RefreshLink
End With
End Function

 

[David C. Holley]

DId you try running the code as-is from the help file?

 

[David C. Holley]

PLEASE avoid reposting a message under a different Subject heading.

 

[David C. Holley]

It should be true, but obviously something's not right. Add a STOP to
the code as I did below and then snoop around with the following statements

TDF.NAME = strNewTable
?TDF.NAME
?strNewTable
?TDF.Name = strNewTable
(Should return TRUE or -1)
?CStr(TDF.Name) = strNewTable
(Should return TRUE or -1)
?Len(TDF.Name)
?Len(strNewTable)
?TDF.Name & "-"
?strNewTable & "-"

The CStr() shouldn't be neccessary to eval the statement but I listed it
here to help snoop out the problem. I added the Len() test to determine
whether or not there are perhaps trailing spaces in the names. The next
two statements would confirm that.

 

[Guest]

Hi Douglas, Thank for the input. However your suggestion did not work.

My is Option is set: "OPTION COMPARE DATABASE".

 

[TC]

Add this at the appropriate point in your code:

debug.print "1>"; TDF.NAME; "<"
debug.print "2>"; strNewTable; "<"
debug.print "3>"; (tdf.name = strNewTable)

Personally, I'd bet money that 1 & 2 will be different, or 3 will show
True.

The purpose of the angle brackets in 1 & 2 is to hilite any leading or
trailing spaces or other undisplayable characters.

HTH,
TC

 

[Guest]

no. maybe I should have.

DId you try running the code as-is from the help file?

 

[Guest]

Hi David, I did the debug thing. NO answears. The two values (tdf.name
and strnewtable) are equal in every way.
tdf.name = "COMMENT1" len=8
strNewTable = "COMMENT1" len=8
Even the debugger tells me that these two are NOT equal.??????????

I tried this :
Temp1 = tdf.name
If Trim(temp1) = Trim(strNewTable) Then

Still they are NOT equal.

My current code:
OPTION COMPARE DATABASE

Function linkme(strDatabase As String, strNewTable As String)
Dim dbs As Database
Dim tdf As TableDef
Dim temp1 As String

Set dbs = CurrentDb()

For Each tdf In dbs.TableDefs
Rem use only the linked tables
If Len(tdf.Connect) > 0 Then
Rem this is a linked table

Rem if this is the name of the table.
Rem then change the database location.
Rem temp1 = CStr(tdf.NAME)
temp1 = tdf.NAME
If Trim(temp1) = Trim(strNewTable) Then
Rem If tdf.NAME = strNewTable Then <==orginal code
tdf.Connect = ";database=" & strDatabase
tdf.RefreshLink
End If

Else
Rem not a connected table
End If
Next tdf

Rem cleanup
Set tdf = Nothing
Set dbs = Nothing

End Function