Code to Change Connection String

[BarbC]

Current Connection String is as follows:

DSN=MS Access Database;DBQ=C:\Needs Based Budget\NBB00_13-14.accdb;DefaultDir=C:\Needs Based Budget;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;

I have an application consisting of an excel 2007 workbook and access 2007 database. I will be deploying to 67 counties. The counties will be placing the files in different locations and the queries to pull the data from Access will not work correctly unless the connection string is changed. I need to modify the code below because I am getting the following error.

C:\Needs Based Budget\Nbboo_13.14.accdb is not a valid path make sure the path name is spelled correctly & that you are connected to the server.

My code is as follows (it used to work in 2003 we just updated to 2007):

Public Sub PathChange()
On Error Resume Next
Dim ws As Worksheet
Dim qy As QueryTable
Dim QueryPath As String 'Path used in the queries
Dim CurrPath As String 'Current path of this workbook
Dim iLen As Integer 'Gets length of the path name
Dim lngPos1 As Long 'Gets location of the ; after path name
Dim lngPos2 As Long 'Gets location of the = before path name
Dim sConn As String
Dim sFindSemi As String ';
Dim sFindEqual As String '=

sFindSemi = ";" 'Search character
sFindEqual = "=" 'Search character

'Get the current path of this workbook
CurrPath = ThisWorkbook.FullName
'Get path length to be used in next step
iLen = Len(CurrPath)
'Remove the .xlsm file extension
CurrPath = Left(CurrPath, iLen - 5)

'Loop through each sheet to get all queries
For Each ws In ActiveWorkbook.Sheets

'Loop through the queries to get the connection and commandtext of each
For Each qy In ws.QueryTables

'Connection string example
'ODBC;DSN=MS Access Database;DBQ=C:\Needs Based Budget\NBB00_13-14.accdb;DefaultDir=C:\Needs Based Budget;DriverId=25;
sConn = qy.Connection
'We want to find the ; after the database name so we start
'our searchafter the first two semi-colons at character 29
lngPos1 = InStr(29, sConn, sFindSemi) 'Find the ;
'We want the = that is directly in front of the drive letter of
'the database pass, so we start the search after the first =
lngPos2 = InStr(10, sConn, sFindEqual)
'Subtracting the smaller position from the larger one reveals the path length
iLen = lngPos1 - lngPos2
'Extract the path name from the connection string
QueryPath = Mid(sConn, lngPos2 + 1, iLen - 7) 'Drop the ; and .accdb

'If the QueryPath and CurrPath paths are not the same, change to the QueryPath
If QueryPath <> CurrPath Then
'Set QueryPath to the current path in Connection
qy.Connection = Application.Substitute(qy.Connection, QueryPath, CurrPath)
'Set QueryPath to the current path in CommandText
qy.CommandText = StringToArray(Application.Substitute(qy.CommandText, QueryPath, CurrPath))
qy.Refresh
Else
'Do Nothing
End If
Next qy
Next ws
End Sub
Function StringToArray(Query As String) As Variant

Const StrLen = 127
Dim NumElems As Integer
Dim Temp() As String
NumElems = (Len(Query) / StrLen) + 1
ReDim Temp(1 To NumElems) As String
For i = 1 To NumElems
Temp(i) = Mid(Query, ((i - 1) * StrLen) + 1, StrLen)
Next i
StringToArray = Temp
End Function