[CaroleN]

Hi, I'm new and stuck trying to design an Excel worksheet with macros that import data from an Access database to populate the spreadsheet. It works fine on my machine, but when I try to move it to another machine the excel file loses the location of the database and comes up with error messages to that effect. Is there a way to include a relative path to the database in the code of the macros so that I can move both files together to any machine? (or any other way of doing it) Please excuse my lack of knowledge if this is an easy one...

Many thanks,
Carole

Unfortunately Excel has a propensity to store absolute paths to
databases. You could run a macro to change the paths. Something like
this one:

Sub ChangeQuerySources()
Dim stFrom As String
Dim stTo As String
Dim stConn As String
Dim QT As QueryTable
Dim WS As Worksheet
Dim V
' change all querytables from one directory to another
' and change the directory from stFrom to stTo
' These are for your case:
stFrom = InputBox("Change database path from:",
Default:="C:\ProjectA\")
If stFrom = "" Then Exit Sub
stTo = InputBox("Change database path to:",
Default:="Y:\App\ProjectA\")
If stTo = "" Then Exit Sub
For Each WS In ActiveWorkbook.Worksheets
For Each QT In WS.QueryTables
stConn = Flatten(QT.Connection)
stConn = Subst(stConn, stFrom, stTo)
QT.Connection = SplitToArray(stConn, 255)
QT.Sql = SplitToArray(Subst(Flatten(QT.Sql), stFrom, stTo), 255)
QT.Refresh BackgroundQuery:=False
Next
Next
End Sub

Function Flatten(V) As String
Dim I As Integer
If IsArray(V) Then
For I = LBound(V) To UBound(V)
Flatten = Flatten & V(I)
Next
Else
Flatten = V
End If
End Function

Function Subst(ByVal InString As String, stReplace As String, stWith As
String) As String
' replace any occurrence of stReplace in InString with stWith
' could use the built in Replace function if using Excel 2000 or later
Dim stResult As String
Dim iChar As String
iChar = InStr(LCase(InString), LCase(stReplace)) ' string compare is
case sensitive
Do While iChar 0
stResult = stResult & Left(InString, iChar - 1) & stWith
InString = Mid(InString, iChar + Len(stReplace))
iChar = InStr(LCase(InString), LCase(stReplace))
Loop
Subst = stResult & InString
End Function

Function SplitToArray(ST As String, Lump As Integer)
' break a long string up into an array with each element of size Lump
' don't bother if string is not longer than Lump
Dim A()
Dim I As Integer
If Len(ST) <= Lump Then
SplitToArray = ST
Else
ReDim A(1 To Len(ST) \ Lump + 1)
For I = 1 To Len(ST) \ Lump + 1
A(I) = Mid(ST, 1 + (I - 1) * Lump, Lump)
Next
SplitToArray = A()
End If
End Function

Bill Manville
MVP - Microsoft Excel, Oxford, England
No email replies please - respond to newsgroup