How to read an ACCESS DB on a different drive 1

[tjessejeff]

I have an application written in Access. I what to give the user the ability to put the DB on any drive. How can I write an application that will allow the user to tell it where the DB is located? I what to have a message that says "Unable to Locate DB, Enter the correct DB path or click Browse to locate DB". Base on entry, store the path so everytime the user executes the application, it will find it.

 

[scriverb]

You are in luck as I have done something like this just recently. Give this a try.

1. Copy and Paste this code in a new database Module:
'************** Code Start **************
'This code was originally written by Terry Kreft.
'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
'Terry Kreft
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
As Long
Private Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
Dim x As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer

With bi
.hOwner = hWndAccessApp
.lpszTitle = szDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With

dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
x = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

If x Then
wPos = InStr(szPath, Chr(0))
BrowseFolder = Left$(szPath, wPos - 1)
Else
BrowseFolder = vbNullString
End If
End Function
'*********** Code End *****************

'************** Code Start **************
'This code was originally written by Bob Scrier.
'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
'Bob Scriver
Public Function InStrRight(vSearchStr As String, vTargetStr As String, vStart As Long) As Long
Dim i As Integer
For i = vStart To 1 Step -1
If InStr(i, vSearchStr, vTargetStr, 1) = i Then
InStrRight = i 'Position of vTargetStr
Exit For
End If
Next i
End Function

2. The following VBA code will prompt for the User to browse to the location of the database. Then it permanently relinks the linked tables to the new location.

Dim db As DAO.Database, TmpTable As TableDef
Dim i As Integer
Set db = CurrentDb
Dim vPath As String
vPath = BrowseFolder("Please browse to the folder where the DB is located.&quot
For i = 0 To db.TableDefs.Count - 1
Set TmpTable = db.TableDefs(i)
If TmpTable.Connect <> &quot;&quot; Then
TmpTable.Connect = &quot;;DATABASE=&quot; & vPath & &quot;\&quot; & Mid$(TmpTable.Connect, InStrRight(TmpTable.Connect, &quot;\&quot;, Len(TmpTable.Connect)) + 1)
TmpTable.RefreshLink
End If
Next i

Now this only has to happen the first time the new application is run after installation. So, you need to have a way to only execute this one time. Setting a flag or reading a table and when it errors make a call to the code are a couple of ways to do this.

Let me know what you think of this process.

Bob Scriver

Nobody believes the official spokesman... but everybody trusts an unidentified source.
Author, Bagdad Bob???

 

[tjessejeff]

Thanks for your help. I will give it a try.

 

[tjessejeff]

I want to thank you for your help. I am happy with the results.

 

[scriverb]

I recommend that you add one more line to the code. In the event you have multiple folders where your tables are located you may have to run this once for each folder. If the connection can't be made for the files not in that folder we want the routine to skip that connection and continue through the entire TableDefs to reconnect the ones that it can. This On Error will do that for you.

On Error Resume Next
Dim db As DAO.Database, TmpTable As TableDef
Dim i As Integer
Set db = CurrentDb
Dim vPath As String
vPath = BrowseFolder(&quot;Please browse to the folder where the DB is located.&quot
For i = 0 To db.TableDefs.Count - 1
Set TmpTable = db.TableDefs(i)
If TmpTable.Connect <> &quot;&quot; Then
TmpTable.Connect = &quot;;DATABASE=&quot; & vPath & &quot;\&quot; & Mid$(TmpTable.Connect, InStrRight(TmpTable.Connect, &quot;\&quot;, Len(TmpTable.Connect)) + 1)
TmpTable.RefreshLink
End If
Next i


Bob Scriver

Nobody believes the official spokesman... but everybody trusts an unidentified source.
Author, Bagdad Bob???

 

[tjessejeff]

Thanks again!