I have a spreadsheet which is linked to an Access DB table. In MS Query,
I changed the drive mapping (eg G:\data\etc) to the server name (eg
\\server\drivename\data\etc) in SQL view.

However, when colleagues who are mapped to the drive under a different
letter try to refresh the spreadsheet, it still comes up with the
error: "Cannot locate G:\data\etc"

Does anyone know why? There are many users in a large multi-site
organisation, and to change everyones mappings would be very
time-consuming.


--
alexkr

Alexkr wrote:
Does anyone know why? There are many users in a large multi-site
organisation, and to change everyones mappings would be very
time-consuming.


The filename will appear in 2 places: in the SQL (annoyingly) and you
have dealt with that, and in the Connection property of the QueryTable.
A further complication is that long Connection strings and SQL strings
have to be split into arrays containing strings which do not exceed 255
characters in length.

Try this macro:

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 = "G:\data\"
stTo = "\\Server\Drivename\Data\"
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
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