programmatically get path for linked database

[Gntlhnds]

I have code set up that I have found in these newsgroups and modified to
compact/backup a backend. The code opens a dialog box for the user to select
the backend to compact/backup. Since there is only one backend, what I would
like to do is have the code programmatically select the backend to
compact/backup. I have pulled the code from mvps.org, but I have no idea how
to implement it. Here's the code that I have now:

'*************** Code Start **************
' This code was originally written by Dev Ashish.
' 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
' Dev Ashish
'
'
Function fGetLinkPath(strTable As String) As String
Dim dbs As Database, stPath As String

Set dbs = CurrentDb()
On Error Resume Next
stPath = dbs.TableDefs(strTable).Connect
If stPath = "" Then
fGetLinkPath = vbNullString
'can change this to currentdb.name
Else
fGetLinkPath = Right(stPath, Len(stPath) _
- (InStr(1, stPath, "DATABASE=") + 8))
End If
Set dbs = Nothing
End Function

Sub sListPath()
Dim loTd As TableDef
CurrentDb.TableDefs.Refresh
For Each loTd In CurrentDb.TableDefs
Debug.Print fGetLinkPath(loTd.name)
Next loTd
Set loTd = Nothing
End Sub

Function DoBackup()
On Error GoTo Err_DoBackup


Dim strBackupFile As String
Dim strCurrentFile As String
Dim strDateStamp As String
Dim strCurrentLockFile As String

MsgBox "First, select the file that contains the tables. Second, select
the folder to save the backup copy.", , "Compact/Backup Procedures"


strCurrentFile = ahtCommonFileOpenSave(DialogTitle:="Please Select the
File with Your Tables")
If Len(strCurrentFile) = 0 Then
MsgBox "Your Tables were not backed up", , "Cancel Backup"
GoTo Exit_DoBackup
Else
'something was selected
End If

DoCmd.Hourglass True
strDateStamp = Format(Date, "yyyy_mm_dd")
strBackupFile = ahtCommonFileOpenSave(FileName:=strDateStamp,
DefaultExt:="mdb", DialogTitle:="Please Select a Location to Save Your
Backup...", OpenFile:=False)
If Len(strBackupFile) = 0 Then
MsgBox "Your Tables were not backed up", , "Cancel Backup"
GoTo Exit_DoBackup
Else
'something was selected
End If
strCurrentLockFile = strCurrentFile & ".ldb"

If Len(Dir(strCurrentLockFile)) > 0 Then
MsgBox "Cannot backup the database: it's in use", , "Backup "
Else
If Len(Dir(strBackupFile)) > 0 Then
Kill strBackupFile
End If
Application.CompactRepair strCurrentFile, strBackupFile
Kill strCurrentFile ' or better to rename it
Application.CompactRepair strBackupFile, strCurrentFile
DoCmd.Beep
MsgBox "Database backup successful...", , "Backup Confirmation"

End If
' Copy the database


Exit_DoBackup:
DoCmd.Hourglass False
Exit Function


Err_DoBackup:
MsgBox Str(Err)
MsgBox Error$
Resume Exit_DoBackup

End Function

**********************************
What I don't know is what to put "strCurrentFile = " to. Right now it is
set to open a Open File dialog box. I prefer leaving the strBackupFile to
what it is now because it allows the user to set the location of the backup
file and to name it what they want. Thanks for your help.

 

[Dirk Goldgar]

In

I have code set up that I have found in these newsgroups and modified
to compact/backup a backend. The code opens a dialog box for the
user to select the backend to compact/backup. Since there is only
one backend, what I would like to do is have the code
programmatically select the backend to compact/backup. I have pulled
the code from mvps.org, but I have no idea how to implement it.
Here's the code that I have now:

'*************** Code Start **************
' This code was originally written by Dev Ashish.
' 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
' Dev Ashish
'
'
Function fGetLinkPath(strTable As String) As String
Dim dbs As Database, stPath As String

Set dbs = CurrentDb()
On Error Resume Next
stPath = dbs.TableDefs(strTable).Connect
If stPath = "" Then
fGetLinkPath = vbNullString
'can change this to currentdb.name
Else
fGetLinkPath = Right(stPath, Len(stPath) _
- (InStr(1, stPath, "DATABASE=") + 8))
End If
Set dbs = Nothing
End Function

Sub sListPath()
Dim loTd As TableDef
CurrentDb.TableDefs.Refresh
For Each loTd In CurrentDb.TableDefs
Debug.Print fGetLinkPath(loTd.name)
Next loTd
Set loTd = Nothing
End Sub

Function DoBackup()
On Error GoTo Err_DoBackup


Dim strBackupFile As String
Dim strCurrentFile As String
Dim strDateStamp As String
Dim strCurrentLockFile As String

MsgBox "First, select the file that contains the tables. Second,
select the folder to save the backup copy.", , "Compact/Backup
Procedures"


strCurrentFile = ahtCommonFileOpenSave(DialogTitle:="Please Select
the File with Your Tables")
If Len(strCurrentFile) = 0 Then
MsgBox "Your Tables were not backed up", , "Cancel Backup"
GoTo Exit_DoBackup
Else
'something was selected
End If

DoCmd.Hourglass True
strDateStamp = Format(Date, "yyyy_mm_dd")
strBackupFile = ahtCommonFileOpenSave(FileName:=strDateStamp,
DefaultExt:="mdb", DialogTitle:="Please Select a Location to Save Your
Backup...", OpenFile:=False)
If Len(strBackupFile) = 0 Then
MsgBox "Your Tables were not backed up", , "Cancel Backup"
GoTo Exit_DoBackup
Else
'something was selected
End If
strCurrentLockFile = strCurrentFile & ".ldb"

If Len(Dir(strCurrentLockFile)) > 0 Then
MsgBox "Cannot backup the database: it's in use", , "Backup "
Else
If Len(Dir(strBackupFile)) > 0 Then
Kill strBackupFile
End If
Application.CompactRepair strCurrentFile, strBackupFile
Kill strCurrentFile ' or better to rename it
Application.CompactRepair strBackupFile, strCurrentFile
DoCmd.Beep
MsgBox "Database backup successful...", , "Backup Confirmation"

End If
' Copy the database


Exit_DoBackup:
DoCmd.Hourglass False
Exit Function


Err_DoBackup:
MsgBox Str(Err)
MsgBox Error$
Resume Exit_DoBackup

End Function

**********************************
What I don't know is what to put "strCurrentFile = " to. Right now
it is set to open a Open File dialog box. I prefer leaving the
strBackupFile to what it is now because it allows the user to set the
location of the backup file and to name it what they want. Thanks
for your help.

Choose one of the linked tables in your application to be the
"pathfinder", then use Dev's function to get the path to the database
that table is linked to. For example, suppose you have a table named
"MyMainTable". Then you would do something like this:

'----- start of modified code snippet -----
Function DoBackup()

On Error GoTo Err_DoBackup

Dim strBackupFile As String
Dim strCurrentFile As String
Dim strDateStamp As String
Dim strCurrentLockFile As String

strCurrentFile = fGetLinkPath("MyMainTable")

MsgBox _
"Select the folder to save the backup copy.", , _
"Compact/Backup Procedures"

DoCmd.Hourglass True

strDateStamp = Format(Date, "yyyy_mm_dd")

strBackupFile = ahtCommonFileOpenSave( _
FileName:=strDateStamp, _
DefaultExt:="mdb", _
DialogTitle:="Please Select a Location to Save Your Backup...", _
OpenFile:=False)

' ... rest of original code goes here ...

'----- end of modified code snippet -----

 

[Gntlhnds]

I've been an idiot. I had tried using this code before, but I kept choosing
the table that was opened via a hidden form to keep the connection between
the front end and back end open, so whenever I ran the code I kept getting an
error. I guess it only works when you are trying to pull the path from a
table that isn't being used at the same time.

 

[Dirk Goldgar]

In

I've been an idiot. I had tried using this code before, but I kept
choosing the table that was opened via a hidden form to keep the
connection between the front end and back end open, so whenever I ran
the code I kept getting an error. I guess it only works when you are
trying to pull the path from a table that isn't being used at the
same time.

I'm curious. What error were you getting? I wouldn't expect there to
be an error, just because the table you're checking happens to be open.

 

[Gntlhnds]

I get "7866" first and then I get an error saying that it can't open the
database because it is missing or opened exclusively by another user.

 

[Gntlhnds]

You're right. I don't get an error. I was getting an error because I didn't
have my tables linked correctly. Silly me.