?
Solved

Why is this code not doing what I think it should

Posted on 2006-05-29
22
Medium Priority
?
358 Views
Last Modified: 2012-06-21
I am using the following code in the Open event of the form that is automatically opened when my app is launched. The code actually works but not when I want it to. The code is meant to refresh links to my BE database making sure it uses the database that is in the same folder as the FE. It does seem to do that but only if its original link to another database exists. The reason I want it is so that when I distribute my app all I need to do is get my users to drop the two databases in a directory of their choice and launch the FE which I had hoped would then find the BE using my code. Can anyone tell me why it only works if the existing link exists and if there is any way to fix it?

Sub LinkTables()
    'automatically link to tables in *_BE.mdb" in same directory
    On Error GoTo MyError
    Dim dbs As Database
    Dim rst As Recordset
    Dim MyPath
    Dim MyFile
    Dim MyDataFile
    Dim MySource
    Dim MyDestination
    Dim usr As String
    Dim tbl As String
    Dim doc As Document
    Dim ctr As Container
    Dim t(500)
    Dim cnt
    Dim cnt2
    Dim fn
   
'gather current table/query
    Set dbs = CurrentDb
    Set ctr = dbs.Containers!Tables  'contains tables and queries in current database
    cnt = 1
    For Each doc In ctr.Documents
        If Left(doc.Name, 1) <> "~" And Left(doc.Name, 4) <> "MSys" Then
            t(cnt) = Trim(doc.Name)
            cnt = cnt + 1
        End If
    Next doc
    cnt2 = cnt

'delete current links
    cnt = 1
    Do While cnt < cnt2
        tbl = t(cnt)
        'will only delete tables not queries - err 2059 when trying to delete a query
        'test for tables in backend - start with tblXXX, so not to delete MAS90 links
        If Left(tbl, 3) = "tbl" Then
            DoCmd.DeleteObject acTable, tbl
            'print bale list for testing
            Debug.Print "Deleted " & tbl
        End If
        cnt = cnt + 1
    Loop

'gather table/query names from back-end database
    MyPath = CurrentProject.Path
    MyFile = CurrentProject.Name
    MyDataFile = MyPath & "\" & Left(MyFile, Len(MyFile) - 4) & "_be.mdb"
    Set dbs = OpenDatabase(MyDataFile)
    cnt = 1
    Set ctr = dbs.Containers!Tables
    For Each doc In ctr.Documents
        If Left(doc.Name, 1) <> "~" And Left(doc.Name, 4) <> "MSys" Then
            t(cnt) = Trim(doc.Name)
            cnt = cnt + 1
        End If
    Next doc
    cnt2 = cnt
   
'create new links
    cnt = 1
    Do While cnt < cnt2
        tbl = t(cnt)
        MySource = tbl
        MyDestination = tbl
        'will only link tables - err 3078 when trying to link a query
        DoCmd.TransferDatabase acLink, "Microsoft Access", MyDataFile, acTable, MySource, MyDestination
        Debug.Print "Re-linked " & tbl
        cnt = cnt + 1
    Loop
   
MyExit:
   
    Exit Sub
   
MyError:
    If Err.Number = 2059 Or Err.Number = 3078 Or Err.Number = 3001 Or Err.Number = 3011 Then
        Resume Next
    Else
        MsgBox Str(Err.Number) & " - " & Err.Description
        GoTo MyExit
        Resume
    End If
End Sub
0
Comment
Question by:Rob4077
  • 9
  • 8
  • 4
  • +1
22 Comments
 
LVL 65

Expert Comment

by:rockiroads
ID: 16782955
perhaps when u want to link queries

u need to specify queries?

DoCmd.TransferDatabase acLink, "Microsoft Access", MyDataFile, acTable, MySource, MyDestination

use acQuery

0
 
LVL 44

Expert Comment

by:Leigh Purvis
ID: 16782967
What do you mean by "only if its original link to another database exists"

If there's a valid link to another BE?
Or if there are any linked table defs at all?  Even if they point at nothing?

Since you're using Access 2000+  (CurrentProject) then you might as well iterate the CurrentProject.AllForms collection rather than the older Container object - no?


Personally - I maintain a local table holding all the table names that I want to link to (and which backend each is contained in).
Then you're just walking through those records - adding the links.
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16782978
Your code is based on the tables from the FE db, assuming this code runs from FE
If u want to link stuff from BE, u need to read the list of tables from the BE
then do the same for queries
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
LVL 65

Accepted Solution

by:
rockiroads earned 1800 total points
ID: 16783107
Im not sure why u would want to bring in queries, are you planning on defining a set then just rolling it out?

anyways, this code, connects to the specified BE db, then reads the tables in there and links those. So if u add a new table in  BE, u can run this code and it will relink


Public Sub RelinkStuff()

    Dim dbData As Database
    Dim tdData As TableDef
    Dim qryData As QueryDef
    Dim sDB As String
   

     'At the moment this is hardcoded to be this DB
    sDB = "C:\EE\EE.MDB"
    err.Clear
    Set dbData = DBEngine.Workspaces(0).OpenDatabase(sDB)
    If err.Number <> 0 Then
        MsgBox "Failed to open database " & sDB & vbCrLf & vbCrLf & err.Description, vbCritical, "EE"
        Exit Sub
    Else
        'Link in tables
        For Each tdData In dbData.TableDefs
            If left(tdData.Name, 1) <> "~" And left(tdData.Name, 4) <> "MSys" Then
                Debug.Print "Linking Table", tdData.Name
                If IsObject(tdData.Name) Then DoCmd.DeleteObject acTable, tdData.Name
                DoCmd.TransferDatabase acLink, "Microsoft Access", sDB, acTable, tdData.Name, tdData.Name
            End If
        Next
   
        For Each qryData In dbData.QueryDefs
            If left(qryData.Name, 1) <> "~" Then
                Debug.Print "Linking Query", qryData.Name
                If IsObject(qryData.Name) Then DoCmd.DeleteObject acQuery, qryData.Name
                DoCmd.TransferDatabase acImport, "Microsoft Access", sDB, acQuery, qryData.Name, qryData.Name
            End If
        Next
    End If
    Set dbData = Nothing

End Sub



With queries, u cant link I dont think, so Ive done a import
0
 
LVL 44

Expert Comment

by:Leigh Purvis
ID: 16783108
Well, you use the
Set dbs = OpenDatabase(MyDataFile)
to open the backend yes?

And then iterate through its tables and link to it thusly.
0
 
LVL 38

Expert Comment

by:puppydogbuddy
ID: 16783196
Rob,
It looks to me that you are deleting and readding links if  ...... Do While cnt < cnt2.....  That being the case,  your code is putting  a self imposed limit of 1 even if more than one link exists. Try changing your code to ......Do while cnt <= cnt2......  

In addition to the above, I believe you have over-complicated the code.  The following  code is provided as a tip by Microsoft certified MVP Tony D'Ambra of   www.aadconsulting.com.  Unlike your code, the links are refreshed as they are found, without any self-imposed constraints like "Do While <"


Public Function RefreshLinks(strFilename As String) As Boolean
' Refresh table links to a backend database - strFilename (full path)
' Returns True if successful.

Dim dbs As Database
Dim tdf As TableDef

' Loop through all tables in the database.
  Set dbs = CurrentDb
  For Each tdf In dbs.TableDefs
         ' If the table has a connect string, it's a linked table.
         If Len(tdf.Connect) > 0 Then
               tdf.Connect = ";DATABASE=" & strFilename
               Err = 0
               On Error Resume Next
                tdf.RefreshLink ' Relink the table.
                        If Err <> 0 Then
                              RefreshLinks = False
                              Exit Function
                        End If
           End If
    Next tdf

    RefreshLinks = True ' Relinking complete.

End Function

 
0
 

Author Comment

by:Rob4077
ID: 16784369
Thanks very much for all your comments. I am in and out of the office at the moment so I won't be able to evaluate the comments for a while. At a quick look I like rockiroads' suggestion: "this code, connects to the specified BE db, then reads the tables in there and links those. So if u add a new table in  BE, u can run this code and it will relink". I assume this would enable me to easily transport my application into whatever directory the user chooses and it would find the BE providing it is in the same directory as the FE.

Also, what is the accepted EE protocol. I usually apportion points to all who have made a valid contribution. Or is it preferred that I allocate all points to the user whose suggestion I adopt?

Rob
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16784409
yes, the code Ive given, it reads the list of tables and queries in the BE, if u add more, it will relink/reimport them , u just need to ensure the FE runs the code to get the updates

problem u had was if u read the FE, u only get the list thats in FE, not any new ones in BE
0
 

Author Comment

by:Rob4077
ID: 16788113
rockiroads,

I've tried your routine and it creates a second, then third... link (each subsequent link has a digit after the file name) to the site every time it is run. I need to get it to re-establish, not duplicate the link.

I tried changing the line
    "If IsObject(tdData.Name) Then DoCmd.DeleteObject acTable, tdData.Name"
to
    "DoCmd.DeleteObject acTable, tdData.Name"
and it works until it hits a table that isn't linked. What have I set up wrong?
0
 

Author Comment

by:Rob4077
ID: 16794710
Just to clarify, even though a link exists, the IsObject(tdData.Name) comes up false so the link is not deleted. The next line then creates a new link to the table and adds a 1 to the name becuase the table already exists. Can you shed light on why this might be happening?
Rob
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16795996
Hi Rob, apologies, I was thinking of something else when I used IsObject
IsObject is the wrong call as that checks to see if a variable is of type object

What Ive done is used On Error Resume Next and check error codes myself
Ive added comments to make it easier for you to read


Public Sub RelinkStuff()

    Dim dbData As Database
    Dim tdData As TableDef
    Dim qryData As QueryDef
    Dim sDB As String
    Dim bLink As Boolean
   
   

    On Error Resume Next
   
     'At the moment this is hardcoded to be this DB
    sDB = "C:\EE\EE2.MDB"
    Err.clear
    Set dbData = DBEngine.Workspaces(0).openDatabase(sDB)
    If Err.Number <> 0 Then
        MsgBox "Failed to open database " & sDB & vbCrLf & vbCrLf & Err.Description, vbCritical, "EE"
        Exit Sub
    Else
   
        'Link tables
        For Each tdData In dbData.TableDefs
            If Left(tdData.name, 1) <> "~" And Left(tdData.name, 4) <> "MSys" Then

                'blink used to determine whether we link or not
                'Initialise to false - assume the worst
                bLink = False
                Err.clear

                'Check if table exists
                Debug.Print CurrentDb.TableDefs(tdData.name).name
                If Err.Number > 0 Then
                    'If number is not 3265, it means table does not exist
                    If Err.Number <> 3265 Then
                        MsgBox "Error Checking Local Table : " & tdData.name & vbCrLf & Err.Description
                    Else
                        bLink = True
                    End If
                'Table exists, lets drop it
                Else
                    DoCmd.DeleteObject acTable, tdData.name
                    bLink = True
                End If
                If bLink = True Then DoCmd.TransferDatabase acLink, "Microsoft Access", sDB, acTable, tdData.name, tdData.name
            End If
        Next
   
        'Import Queries
        For Each qryData In dbData.QueryDefs
            If Left(qryData.name, 1) <> "~" Then
               
                bLink = False
                Err.clear

                Debug.Print CurrentDb.QueryDefs(qryData.name).name
                If Err.Number > 0 Then
                    'If number is not 3265, it means table does not exist
                    If Err.Number <> 3265 Then
                        MsgBox "Error Checking Local Query : " & tdData.name & vbCrLf & Err.Description
                    Else
                        bLink = True
                    End If
                'Query exists, lets drop it
                Else
                    Debug.Print "Deleting Local Query", qryData.name
                    DoCmd.DeleteObject acQuery, qryData.name
                    bLink = True
                End If
                Debug.Print "Importing Query", qryData.name
                If bLink = True Then DoCmd.TransferDatabase acImport, "Microsoft Access", sDB, acQuery, qryData.name, qryData.name
            End If
        Next
   
    End If

End Sub

0
 

Author Comment

by:Rob4077
ID: 16797818
Thanks rockiroads.

The code works perfectly in that it re-links on my PC. However when I transfer to another PC, I run into a problem in that I get a message that says "'c:\....(my original file path)...\myfile_BE.mdb' is not a valid path. Make sure that the path name is spelled correctly and that you are connected to the server on which the file resides."  I tried putting a Stop in the first line of your sub but I don't even get that far. It seems to want to try to link to the existing back end first then run the On Open event which kills the link and creates the new one. That means I can't just get the users to install the two mdf files (FE and BE) in a folder of their choice and launch to re-establish the links. Again, what am I doing wrong?

Rob
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16804991
ok. the problem is finding the current backend?

ok, try this check at the beginning


Dim sDB as String

sDB = currentproject.path & "\myfile_BE.mdb"
if dir$(sDB) = "" then
   msgbox "Unable to find Backend Database " & sDB
   exit sub
end if

0
 

Author Comment

by:Rob4077
ID: 16805085
Not sure if I've explained the problem clearly. The original code works providing there is a link in place, ie on my existing machine. The problem is if I take my front end and back end mdfs and drop them on a new machine then double click on the FE.mdf. BEFORE it even executes the ReLink code I get the above message.

Following is the code that I have in my On Open event of the form called Main. The application is set up to automatically open this form when launched. The form "Welcome" referred to in the code is just a welcome message. The sub LinkTables is the code you gave me earlier. When I launch the application I get the above message (ie "'c:\....(my original file path)...\myfile_BE.mdb' is not a valid path. Make sure that the path name is spelled correctly and that you are connected to the server on which the file resides.") before it even gets to display the Welcome screen, let alone the new code you suggest above.

I'm getting the feeling that I will need to kill the link to the BE as part of my On Close routine and then use your code to create a fresh link when the application opens again. Is my assumption correct?

Private Sub Form_Open(Cancel As Integer)
   
    DoCmd.OpenForm "Welcome"
    DoEvents
    Dim sDB As String

sDB = CurrentProject.Path & "\myfile_BE.mdb"
If Dir$(sDB) = "" Then
   MsgBox "Unable to find Backend Database " & sDB
   Exit Sub
End If
    LinkTables
 
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16805131
Could it be that u sent out a DB with links to your path
Now the first form u open, does it do any database reads? is it bounded to any table/query?

I could only think that its trying to access the DB, but it cant cos the linked table does not exist in the path it was set to

does that make sense?
0
 

Author Comment

by:Rob4077
ID: 16805171
No the Welcome form does not have a data source and contains no displays nor does it have a module (HasModule = No). The form Main for which the obove is the On Open event is linked to front and back end databases and they're the ones I want to refresh. Yes the DB I sent out does have links to my path and they are the ones I want to delete and refresh, which I thought your code did. Do I need to delete those links manually before I send out my application and then let the code re-establish them? If that is the case then why does the code need to delte the link and then re-link? I know they're probably dumb questions to you but I am trying to learn as I go
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16805186
Ok Rob, I did the code based on what u had, also if u sent out a new table in BE, u dont have to worry


best way to test is just create a standalone form with one button, the code for this button is
msgbox "Hello"
then make this the start form in Access


another thing
create a new DB
manually link in all tables
create that same form with one button

what happens


I have to go to work now, but I will do the same test later and run the code Ive supplied
I will try track it down also

0
 
LVL 44

Expert Comment

by:Leigh Purvis
ID: 16805702
Is the problem not just that you have specific error handling code that only handles for the error code of a missing table - rather than an improperly/broken linked one?
Check for error 3024 as well.

(Or don't be so specific with it all - just have a general data hit/fail checking and relinking routine.)

Hello again - by the way :-)
0
 

Author Comment

by:Rob4077
ID: 16807172
Hi Leigh,
good to hear from you again and thanks for your comments.

This one is confusing me and not really helping me understand MS Access. I don't know that error routine is an issue. Have a look at the opening code. I thought that the first thing that was executed when a form is opened is the On Open event which is as follows. Yet this app crashes before it even gets to this. In fact I just realised that the msgbox should come up straight away because there is no such db as myfile_BE.mdb (I didn't change it to the right name), however it crashes before it even gets there. If I understand rockiroads suggestion, what I need to do is try to put the relink code in an unbound form to see if the re-link works there. Once the database is relinked then open a bound form to see if that works better. I am trying to understand MS Access but I wonder if I am simply too old.

Private Sub Form_Open(Cancel As Integer)
   
    DoCmd.OpenForm "Welcome"
    DoEvents
    Dim sDB As String

sDB = CurrentProject.Path & "\myfile_BE.mdb"
If Dir$(sDB) = "" Then
   MsgBox "Unable to find Backend Database " & sDB
   Exit Sub
End If
0
 

Author Comment

by:Rob4077
ID: 16807281
OK, I just tried doing that and it seems promising. So now I have the On Open event in the Welcome form that re-links the tables. At the end of the process, how do I close the Welcome form and launch the Main form and let it take over the process?
0
 
LVL 44

Assisted Solution

by:Leigh Purvis
Leigh Purvis earned 200 total points
ID: 16807355
A "splash" screen / welcome form is always a good idea.
Users can think it's a pointless little Hell0 - but it's an opportunity to run everything you want to run before launching into your application properly.
So before you load any bound forms - or open any recordsets - your check for data links should run safely there (as you're finding it seems).

Then when you're finished running any and all startup code you want to - you just close the current form and launch your applications "real" startup form.

With Docmd
    .Close acform, "StartupCodeFormName"
    .OpenForm "ApplicationStartupMenu"
End With
0
 

Author Comment

by:Rob4077
ID: 16807429
Thanks Leigh,
Actually I had just figured it out when I got your message. Tried it and it works perfectly. Thanks very much. I think this has actually helped me understand Access better. I now understand that before the Open event happens only after the form has established a link to any tables used by the form. By using an unbound splash screen I avoid the hassles. Since rockiroads has persevered so long on this one I will award the bulk of points to him but I will give you a few points because you answered my final question.

Thanks to both of you, and indeed to puppydogbuddy for earlier comments too.

Rob
0

Featured Post

 [eBook] Windows Nano Server

Download this FREE eBook and learn all you need to get started with Windows Nano Server, including deployment options, remote management
and troubleshooting tips and tricks

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Traditionally, the method to display pictures in Access forms and reports is to first download them from URLs to a folder, record the path in a table and then let the form or report pull the pictures from that folder. But why not let Windows retr…
This article shows how to get a list of available printers for display in a drop-down list, and then to use the selected printer to print an Access report or a Word document filled with Access data, using different syntax as needed for working with …
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …
This lesson discusses how to use a Mainform + Subforms in Microsoft Access to find and enter data for payments on orders. The sample data comes from a custom shop that builds and sells movable storage structures that are delivered to your property. …
Suggested Courses

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question