View Single Post
  #2   Report Post  
Bill Manville
 
Posts: n/a
Default

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