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?
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?
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?
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.
ASKER
Ok Please do,
Thanx
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
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
ASKER
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)
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)
ASKER
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).OpenDataba se(strPath Name & 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
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
' If no path is provided use the same path as the front end
If strPathName = "" Then strPathName = getpath(CurrentDb.Name)
If StrComp(Right(strPathName,
' 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).OpenDataba
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
ASKER
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"
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"
ASKER
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.
"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.CloseCurrentData base '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.
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.CloseCurrentData
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.
ASKER
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\Linktable s2k_be.mdb
---Contact administrator.
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\Linktable
---Contact administrator.
ASKER
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.
Org: Call RefreshLinks(cboFileName)
Changed it to: Call RefreshLinks(, cboFileName)
Then I get first error message.
ASKER
The tdf.Name in the loop first is set to ~TMPCLP106301.
What is this coming from?
What is this coming from?
ASKER
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).
ASKER
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.
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_ENABLETEMPLATEHANDL E = &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(Init ialDir:="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(varTitleForDialo g) 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 ()
>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,
' 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_ENABLETEMPLATEHANDL
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
"*.MDA;*.MDB")
strFilter = ahtAddFilterItem(strFilter
strFilter = ahtAddFilterItem(strFilter
strFilter = ahtAddFilterItem(strFilter
MsgBox "You selected: " & ahtCommonFileOpenSave(Init
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(varTitleForDialo
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
' 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
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 ()
ASKER
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 am in over my head if I would try.
ASKER
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
'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,
ASKER
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?
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?
ASKER
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 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.
ASKER
>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
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
ASKER
First the strName in StartupLinkCheck is:
strName = "C:\Access_FE_BE\Installat ionBE.mdb"
In RefreshLinks:
strFileName = "InstallationBE"
strPathName = "C:\Access_FE_BE\"
strName = "C:\Access_FE_BE\Installat
In RefreshLinks:
strFileName = "InstallationBE"
strPathName = "C:\Access_FE_BE\"
ASKER
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"
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
' If no path is provided use the same path as the front end
If strPathName = "" Then strPathName = getpath(CurrentDb.Name)
If StrComp(Right(strPathName,
' Append trailing backslash to path.
strPathName = strPathName & "\"
End If
strFileName = strFileName & ".mdb"
ASKER
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
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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
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
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
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
ASKER
Thank you, it might come in handy.
Thomas
Thomas
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