Update Microsoft Query ODBC Connection and Command text through VBA

[MzCheez]

My company current migrated our data to a new server. On doing so I updated the ODBC connection but that did not update in any of my 100+ microsoft queries.

After a lot of research I was able to put the follow two together. But when I came to a report that had multiple tables, the second VBA didnt work and i had to do them manually. Please help:

Sub Fixmyreport1()

Dim conn As WorkbookConnection
Dim sOldConnection As String, sNewConnection As String

Const sOldPath As String = "\\VM2" '--omit trailing backslashes to change DefaultDir
Const sNewPath As String = "\\chr-timber"

For Each conn In ActiveWorkbook.Connections
With conn
If .Type = xlConnectionTypeODBC Then
sOldConnection = .ODBCConnection.Connection
If InStr(1, sOldConnection, sOldPath) > 0 Then
sNewConnection = Replace(sOldConnection, _
sOldPath, sNewPath, compare:=vbTextCompare)
.ODBCConnection.Connection = sNewConnection
End If
End If
End With
Next conn

Set conn = Nothing

End Sub

Public Sub fixmyreport2()

Dim ws As Worksheet, lo As ListObject, qt As QueryTable, prev As String

For Each ws In ActiveWorkbook.Worksheets
For Each lo In ws.ListObjects
Set qt = lo.QueryTable
prev = qt.CommandText
qt.CommandText = Replace(qt.CommandText, "\\VM2", "\\chr-timber", compare:=vbTextCompare)
MsgBox "Previous CommandText: " & prev & vbCrLf & "New CommandText: " & qt.CommandText
Next
Next

End Sub

 

[MzCheez]

@John_w - I got the second portion from you. I was hoping you could help me adjust it. Or even make the whole Macro one.

 

[MzCheez]

looks like the list objects causing the issue