Sub ChangeConn()
Dim wbBook As Workbook
Dim qt As QueryTable
Dim Wsh As Worksheet
Dim OldLoc As String, OldPath As String
Dim NewLoc As String, NewPath As String
Dim LastSlash As Long
Const Ext As String = ".mdb"
Set wbBook = ActiveWorkbook
Set Wsh = wbBook.Worksheets(1)
Range("a1").Select
OldLoc = Selection.Value
Range("a2").Select
NewLoc = Selection.Value
LastSlash = InStrRev(OldLoc, "\", , vbTextCompare)
OldPath = Left(OldLoc, LastSlash - 1)
LastSlash = InStrRev(NewLoc, "\", , vbTextCompare)
NewPath = Left(NewLoc, LastSlash - 1)
For Each Wsh In wbBook.Worksheets
For Each qt In Wsh.QueryTables
qt.Connection = Replace(qt.Connection, OldLoc & Ext, NewLoc & Ext)
qt.CommandText = Replace(qt.CommandText, OldLoc, NewLoc)
qt.Connection = Replace(qt.Connection, OldPath, NewPath)
qt.Refresh
Next qt
Next Wsh
End Sub
|