Link to home
Start Free TrialLog in
Avatar of thompa_in_tokyo
thompa_in_tokyo

asked on

Upgrading a database to a newer release

Basically, the improvements are situated to forms and modules so I only need to replace the existing tables with the "same" tables which are located in an older database.
So, how can I import all tables from the old database.

Should I first delete all existing tables and then make an import of the wanted?
If so, how can I automate this by code?
Avatar of peter57r
peter57r
Flag of United Kingdom of Great Britain and Northern Ireland image

Hi thompa_in_tokyo,
You would be better off splitting your database into front-end programs and back-end tables, using the database splitter tool.
(You also need to get to know the Linked Tables Manager tool as well)
Then you will never have this problem again, as you just have to replace the front-end.


Pete
Avatar of thompa_in_tokyo
thompa_in_tokyo

ASKER

Yes I have though about it too. The problem is that this database is transported and is never located at the same directory.
Is it possible to have a relative path to the table destination? For instance the same directory as the front-end?
You can have code automatically link to the backend when the database opens.  I can send you the code for that.
Ok Please do,
Thanx
I have expanded the code to link the front end to back end to do several additional things:
Check to see if the back end is linked the link it if it is not.
Be able to shut down everyone working in the database (for maintenance.)
Let user browse and specify the location of the back end.
Display the progress of the linking.

So here is the link to the basic link back end code:
http://www.rogersaccesslibrary.com/download3.asp?SampleName=LinkTables.mdb

You will need to copy and paste these modules into your database to make it work:
basLinkTable
basPathFileName

The module basCreateDatabases is just used for Roger's example.

If you need any help importing the code into your db or want any of the additional functionality I listed above, let me know.

Nelson
Ok, this is perfect.
So how do I make this work?
I would like to use two destinations of the table database.
First as you have in your example (same destination as current).
Second, a specified directory.

Bye the way, the base did not start up properly because of a misspelling (As DDAO.atabase)

How can I get this function to get all tables?
>I would like to use two destinations of the table database.
Do you want the database to check for the backend in the two locations then link to where it is found?

Second, a specified directory.
Specified by you in code or some other location or specified by the user?

Here is the code to relink all the linked tables. Replace Roger's "Sub LinkTables" & "Sub LinkTables2" with this:

Public Sub RefreshLinks(Optional strPathName As String = "", _
    Optional strFileName As String = "")
' Refresh links to the supplied database.

    Dim dbs As Database
    Dim dbsLink As DAO.Database
    Dim tdf As TableDef
   
    DoCmd.Hourglass True    'Change the mouse curser to hourglass

    ' If no filename is provided use the front end filename plus "_be.mdb"
    If strFileName = "" Then strFileName = getfileroot(CurrentDb.Name) & "_be.mdb"

    ' If no path is provided use the same path as the front end
    If strPathName = "" Then strPathName = getpath(CurrentDb.Name)
   
    If StrComp(Right(strPathName, 1), "\", vbTextCompare) <> 0 Then
        ' Append trailing backslash to path.
        strPathName = strPathName & "\"
    End If

    DoCmd.RunCommand acCmdAppMaximize    ' I want my database to always run maximized

    ' Loop through all tables in the database.
    On Error GoTo RefreshLinks_Error
    Set dbs = CurrentDb()
    Set dbsLink = DAO.DBEngine(0).OpenDatabase(strPathName & strFileName)
    Err = 0
    For Each tdf In dbs.TableDefs
        ' If the table has a connect string, it's a linked table.
        If Len(tdf.Connect) > 0 Then
            'Show file that is being linked in status bar
            SysCmd SYSCMD_SETSTATUS, "Linking " & tdf.Name
            tdf.Connect = ";DATABASE=" & strPathName & strFileName
            tdf.RefreshLink         ' Relink the table.
        End If
    Next tdf
DoCmd.Hourglass False    '  Set mouse curser back to normal
SysCmd acSysCmdClearStatus    '  Clear the staus line
Exit Sub

RefreshLinks_Error:
If Err = 3044 Then
    MsgBox "RefreshLinks: Unable to link to " & strPathName & strFileName & _
        vbCr & "       --Contact administrator.", vbCritical
ElseIf Err = 3024 Then
    MsgBox "RefreshLinks: Unable to find the file: " & strPathName & _
        strFileName & vbCr & "       --Contact administrator.", vbCritical
ElseIf Err = 3011 Then
    MsgBox "RefreshLinks: Unable to find the table: " & tdf.Name _
        & vbCr & "       --Contact administrator.", vbCritical
Else
    MsgBox "RefreshLinks: Unable to link data files." & Chr(13) & "Unable to run database." & _
        Chr(13) & Chr(13) & "'" & strFileName & Chr(13) & _
        "     needs to be in the same folder as" & Chr(13) & "'" & strFileName & _
        "(Folder: '" & strPathName & "')" & Chr(13) & "(Linked file: '" & tdf.Name _
        & "')" & Chr(13) & Chr(13) & "       --Otherwise contact administrator.)", _
        vbCritical
End If
CloseCurrentDatabase

End Sub
Actually I would like the user to point out where the base is located.

I can't get this code to work. I replaced as you said and called the function with a new cmdButton.
It stops on "getfileroot" (sub or function not defined).
Im using the database "LinkTables2k"
If I bypass that function by setting "strFileName" to a filename I run into the msgBox
"Unable to link, contact admin...." and the program hangs.
Oop, Sorry,

add this function to the basLinkTable module:

Private Function getfileroot(FileName As String) As String
getfileroot = (Mid(Dir(FileName), 1, Len(Dir(FileName)) - 4))
End Function

Does the program hang after you click "Ok" in the msgbox "Unable to link, contact admin....".  If yes replace:
CloseCurrentDatabase
with:
CurrentDb.CloseCurrentDatabase      'to close the db but leave Access open
DoCmd.Quit acQuitSaveAll                'to close the db and Access


Reading between your lines, this is what I think you want when the database starts:
1. Check to see if the current link path is valid
2. If it is not valid, check the path the front end is in.
3. If the BE is not in the same path as the FE, ask the user to find it.

If that is what you want, I can give you the code to do that.
Also, give me the name of one of the tables in your back end.  Anyone will do.  "Switchboard Items" will work if you use that. and the name of your back end.
Your idea about startup sounds good, it would be nice to integrate that too.
Lets call the Backend "InstallationBE" and a table is named "tblRecipients".
Sorry, the base does'nt hang, after the error message is acknowledged the code is doing "CloseCurrentDatabase" and leaves it the curser on hourglass.

I tried it with the new code but....
If I try by simply calling the Refreshlinks by a cmdbutton I get error message:
Refreshlinks:Unable to find the table:~TMPCLP106301
---Contact administrator.

If I use the attach button with a selected base I get this message:
Refreshlinks:Unable to link to LinkRemoteAB.mdb\Linktables2k_be.mdb
---Contact administrator.
Regarding the second error message, it was caused by missing string.
Org: Call RefreshLinks(cboFileName)
Changed it to: Call RefreshLinks(, cboFileName)

Then I get first error message.
The tdf.Name in the loop first is set to ~TMPCLP106301.
What is this coming from?
I did as before to run the code by adding a cmdButton. Now I don't get any error but nothing happens. No tables have been linked from the base LinkTables2k_be (which is my own base).
Hmmm, sorry again. Seems I have done something to the code...
I started over and inserted the code "RefreshLinks"
Now it seems different but not functioning.
Now I get MsgBox "Items not found in this collection"
.....Ahaaaa, It requires that there are linked tables already, of course. Now I got it to work.
>The tdf.Name in the loop first is set to ~TMPCLP106301.
>What is this coming from?
Try a compact and repair database.

>Sorry, the base does'nt hang, after the error message is acknowledged the code is doing "CloseCurrentDatabase" and >leaves it the curser on hourglass.
Put:
DoCmd.Hourglass False    '  Set mouse curser back to normal
SysCmd acSysCmdClearStatus    '  Clear the staus line
in front of:
CloseCurrentDatabase


Add this function to the basLinkTable module:

Public Function StartUpLinkCheck()
    Dim dbs As Database
    strName As String
   
    Set dbs = CurrentDb()

    ' Open linked table to see if connection information is correct.
    On Error Resume Next
    dbs.OpenRecordset ("tblRecipients")

    ' If tblRecipientsis found, exit.  
    If Err = 0 Then  
        dbs.close
        set dbs = Nothing
        Exit Function  
    End If
    Err = 0

    'Otherwise check if BE is in same path as FE
    strName = getpath(CurrentDb.Name)
   
    If StrComp(Right(strPathName, 1), "\", vbTextCompare) <> 0 Then
        ' Append trailing backslash to path.
        strName = strName & "\"
    End If

    'If BE is found, link to it and exit
    If Dir(strPathName & "InstallationBE.mdb") <> "" Then
        RefreshLinks
        dbs.close
        set dbs = Nothing
        Exit Function  
    End If
 
    'Otherwise ask user to locate BE
    strName = getopenmdbfile (,"Please locate the back end file")
    If strName <> Then   RefreshLinks getpath(strName), getfileroot(strName) Else CloseCurrentDatabase
End Function
'************** Code End *****************

Create a module named "modOpenSaveDialog" and place the following code in it:

Option Compare Database
Option Explicit

'***************** Code Start **************
'This code was originally written by Ken Getz.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
' Code courtesy of:
' Microsoft Access 95 How-To
' Ken Getz and Paul Litwin
' Waite Group Press, 1996

Type tagOPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    strFilter As String
    strCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    strFile As String
    nMaxFile As Long
    strFileTitle As String
    nMaxFileTitle As Long
    strInitialDir As String
    strTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    strDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
    Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean

Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
    Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
' You won't use these.
'Global Const ahtOFN_ENABLEHOOK = &H20
'Global Const ahtOFN_ENABLETEMPLATE = &H40
'Global Const ahtOFN_ENABLETEMPLATEHANDLE = &H80
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
' New for Windows 95
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000

Function TestIt()
    Dim strFilter As String
    Dim lngFlags As Long
    strFilter = ahtAddFilterItem(strFilter, "Access Files (*.mda, *.mdb)", _
                    "*.MDA;*.MDB")
    strFilter = ahtAddFilterItem(strFilter, "dBASE Files (*.dbf)", "*.DBF")
    strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT")
    strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")
    MsgBox "You selected: " & ahtCommonFileOpenSave(InitialDir:="C:\", _
        Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
        DialogTitle:="Hello! Open Me!")
    ' Since you passed in a variable for lngFlags,
    ' the function places the output flags value in the variable.
    Debug.Print Hex(lngFlags)
End Function

Function GetOpenMDBFile(Optional varDirectory As Variant, _
    Optional varTitleForDialog As Variant) As Variant
' Here's an example that gets an Access database name.
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
' Specify that the chosen file must already exist,
' don't change directories when you're done
' Also, don't bother displaying
' the read-only box. It'll only confuse people.
    lngFlags = ahtOFN_FILEMUSTEXIST Or _
                ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
    If IsMissing(varDirectory) Then
        varDirectory = ""
    End If
    If IsMissing(varTitleForDialog) Then
        varTitleForDialog = ""
    End If

    ' Define the filter string and allocate space in the "c"
    ' string Duplicate this line with changes as necessary for
    ' more file templates.
    strFilter = ahtAddFilterItem(strFilter, "Access *.mdb, *.mda", "*.mdb; *.mda")
    ' Now actually call to get the file name.
    varFileName = ahtCommonFileOpenSave( _
                    OpenFile:=True, _
                    InitialDir:=varDirectory, _
                    Filter:=strFilter, _
                    Flags:=lngFlags, _
                    DialogTitle:="Please locate the back end file:")
    If Not IsNull(varFileName) Then
        varFileName = TrimNull(varFileName)
    End If
    GetOpenMDBFile = varFileName
End Function

Function ahtCommonFileOpenSave( _
            Optional ByRef Flags As Variant, _
            Optional ByVal InitialDir As Variant, _
            Optional ByVal Filter As Variant, _
            Optional ByVal FilterIndex As Variant, _
            Optional ByVal DefaultExt As Variant, _
            Optional ByVal FileName As Variant, _
            Optional ByVal DialogTitle As Variant, _
            Optional ByVal hwnd As Variant, _
            Optional ByVal OpenFile As Variant) As Variant
' This is the entry point you'll use to call the common
' file open/save dialog. The parameters are listed
' below, and all are optional.
'
' In:
' Flags: one or more of the ahtOFN_* constants, OR'd together.
' InitialDir: the directory in which to first look
' Filter: a set of file filters, set up by calling
' AddFilterItem. See examples.
' FilterIndex: 1-based integer indicating which filter
' set to use, by default (1 if unspecified)
' DefaultExt: Extension to use if the user doesn't enter one.
' Only useful on file saves.
' FileName: Default value for the file name text box.
' DialogTitle: Title for the dialog.
' hWnd: parent window handle
' OpenFile: Boolean(True=Open File/False=Save As)
' Out:
' Return Value: Either Null or the selected filename
Dim OFN As tagOPENFILENAME
Dim strFileName As String
Dim strFileTitle As String
Dim fResult As Boolean
    ' Give the dialog a caption title.
    If IsMissing(InitialDir) Then InitialDir = CurDir
    If IsMissing(Filter) Then Filter = ""
    If IsMissing(FilterIndex) Then FilterIndex = 1
    If IsMissing(Flags) Then Flags = 0&
    If IsMissing(DefaultExt) Then DefaultExt = ""
    If IsMissing(FileName) Then FileName = ""
    If IsMissing(DialogTitle) Then DialogTitle = ""
    If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
    If IsMissing(OpenFile) Then OpenFile = True
    ' Allocate string space for the returned strings.
    strFileName = Left(FileName & String(256, 0), 256)
    strFileTitle = String(256, 0)
    ' Set up the data structure before you call the function
    With OFN
        .lStructSize = Len(OFN)
        .hwndOwner = hwnd
        .strFilter = Filter
        .nFilterIndex = FilterIndex
        .strFile = strFileName
        .nMaxFile = Len(strFileName)
        .strFileTitle = strFileTitle
        .nMaxFileTitle = Len(strFileTitle)
        .strTitle = DialogTitle
        .Flags = Flags
        .strDefExt = DefaultExt
        .strInitialDir = InitialDir
        ' Didn't think most people would want to deal with
        ' these options.
        .hInstance = 0
        '.strCustomFilter = ""
        '.nMaxCustFilter = 0
        .lpfnHook = 0
        'New for NT 4.0
        .strCustomFilter = String(255, 0)
        .nMaxCustFilter = 255
    End With
    ' This will pass the desired data structure to the
    ' Windows API, which will in turn it uses to display
    ' the Open/Save As Dialog.
    If OpenFile Then
        fResult = aht_apiGetOpenFileName(OFN)
    Else
        fResult = aht_apiGetSaveFileName(OFN)
    End If

    ' The function call filled in the strFileTitle member
    ' of the structure. You'll have to write special code
    ' to retrieve that if you're interested.
    If fResult Then
        ' You might care to check the Flags member of the
        ' structure to get information about the chosen file.
        ' In this example, if you bothered to pass in a
        ' value for Flags, we'll fill it in with the outgoing
        ' Flags value.
        If Not IsMissing(Flags) Then Flags = OFN.Flags
        ahtCommonFileOpenSave = TrimNull(OFN.strFile)
    Else
        ahtCommonFileOpenSave = vbNullString
    End If
End Function

Function ahtAddFilterItem(strFilter As String, _
    strDescription As String, Optional varItem As Variant) As String
' Tack a new chunk onto the file filter.
' That is, take the old value, stick onto it the description,
' (like "Databases"), a null character, the skeleton
' (like "*.mdb;*.mda") and a final null character.

    If IsMissing(varItem) Then varItem = "*.*"
    ahtAddFilterItem = strFilter & _
                strDescription & vbNullChar & _
                varItem & vbNullChar
End Function

Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
    intPos = InStr(strItem, vbNullChar)
    If intPos > 0 Then
        TrimNull = Left(strItem, intPos - 1)
    Else
        TrimNull = strItem
    End If
End Function
'************** Code End *****************

Finally, create a macro called "AutoExec" with:
Action:   Run Code
Function Name:  StartUpLinkCheck ()

When you state the database, AutoExec will run StartUpLinkCheck ()
Hi again, There is some compile errors, can you take a look at your code.
I am in over my head if I would try.
I found: (missing argument <>)
'Otherwise ask user to locate BE
    strName = getopenmdbfile (,"Please locate the back end file")
    If strName <> Then   RefreshLinks getpath(strName), getfileroot(strName) Else CloseCurrentDatabase
End Function

And: (No Dim for strName)
Public Function StartUpLinkCheck()
    Dim dbs As Database
    strName As String

And: (variable not defined "strPathName")
If StrComp(Right(strPathName, 1), "\", vbTextCompare) <> 0 Then
Also,
First time I tried this new code I forgot to rename my base so now at startup it is always asking for the old name(construct2003.mdb) instead of InstallationBE.mdb
Where is this reference set?
I got it to work after declaring the variable. However, if I remove the backend to a different location and selecting the file at a new location it says "unable to find..."
>First time I tried this new code I forgot to rename my base so now at startup it is always asking for the old name(construct2003.mdb)
Did you get this solved?  If you rename the be to InstallationBE and put it in the same folder as the fe, the code should take care of it.

> I got it to work after declaring the variable.
Did I forget to declare a variable?  Which one?

>if I remove the backend to a different location and selecting the file at a new location it says "unable to find..."
Put a break point at:
    If strName <> Then   RefreshLinks getpath(strName), getfileroot(strName) Else CloseCurrentDatabase
in StartUpLinkCheck() and tell me what strName is.  Then single step into the first line of RefreshLinks and tell me what strPathName  and strFileName are.
>Did I forget to declare a variable?  Which one?
See above comments.

About naming of database:
In code StartupLinkCheck the string "InstallationBE.mdb" is named and I have one in same location as FE but it only works when I name the BE to Installation_be (which is referred to in Refreshlinks)

In the line below I initially got "Compile error, expected expression(at "Then")
But when I enter "" before "Then" it passes but I get "Unable to find file: C:\xxxxx\xxxx) .
"xxx" is the correct path and the correct filename (the extension .mdb is not shown in the message, could that be the reason?)
If strName <> Then RefreshLinks getpath(strName), getfileroot(strName) Else CloseCurrentDatabase

First the strName in StartupLinkCheck is:
strName = "C:\Access_FE_BE\InstallationBE.mdb"

In RefreshLinks:
strFileName = "InstallationBE"
strPathName = "C:\Access_FE_BE\"


Hello again,
I got it all to work after I put in the last line in this following code:
But of course, now it won't work if strFileName = "" which would give a string like:
"Installation_be.mdb.mdb"
So how can I get around that?

Public Sub RefreshLinks(Optional strPathName As String = "", _
    Optional strFileName As String = "")
' Refresh links to the supplied database.

    Dim dbs As Database
    Dim dbsLink As DAO.Database
    Dim tdf As TableDef
   
    DoCmd.Hourglass True 'Change the mouse curser to hourglass

    ' If no filename is provided use the front end filename plus "_be.mdb"
    If strFileName = "" Then strFileName = getfileroot(CurrentDb.Name) & "_be.mdb"

    ' If no path is provided use the same path as the front end
    If strPathName = "" Then strPathName = getpath(CurrentDb.Name)
    If StrComp(Right(strPathName, 1), "\", vbTextCompare) <> 0 Then
       
        ' Append trailing backslash to path.
        strPathName = strPathName & "\"
       
    End If
        strFileName = strFileName & ".mdb"
Hmmm,
Now it all works fine except when strName = ""
BUT....
If I move the BE and after it says "could not find..." it jumps into the code to "GetOpenMDBFile" and pauses and when I press continue I works fine.

Why does it jump into this line and pause?
'Otherwise ask user to locate BE
    strName = GetOpenMDBFile(, "Please locate the back end file")
    If strName <> "" Then RefreshLinks getpath(strName), getfileroot(strName) Else CloseCurrentDatabase
   
ASKER CERTIFIED SOLUTION
Avatar of thenelson
thenelson

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Actually, It's working correctly now just after I added some unrelated macro-commands after the runcode in Autoexec. It does'nt pause in the code anylonger.

Great thanx, good work!
Best regards/Thomas
I glad it is working for you.  Thanks for the points.

Sometimes Access places an invisible break in code.  Seems to be a bug.  To get rid of the break try:
Set a break at the point that breaks, reset it then save.
or
decompile:  in the run dialogue, type: msaccess "path\dbname" decompile; then compact/repair; then compile; then compact/repair  (this routine is useful from time to time to reduce the size of your db and make it run faster.)

So the next thing you want is an automatic way for everyone to get the new updated FE.  I have that but that is another question.

Good luck!

Nelson
Thomas,

Thought I'd let you know that I upgraded the link be routine.  The version at :
http://www.nosuffering.com/Nelson/Link%20BE%20Demo.zip
has a form where the user can specify where the link file is, search or browse for it.   It also has a progress meter.  Note: this version expects the BE name to be the same name as the front end with _be appended to it,  for example FE: "db1.mdb"  BE: "db1_be.mdb".

Nelson
Thank you, it might come in handy.
Thomas