VBA Kalkulation unterdrücken bei Query.Refresh

Sub Query_Update()
Dim oldDir As String
Dim newDir As String
Dim ws As Worksheet
Dim qt As QueryTable
Dim lngCalcStatus As Long
lngCalcStatus = Application.Calculation
If lngCalcStatus  -4135 Then Application.Calculation = xlCalculationManual
newDir = ThisWorkbook.Path
For Each ws In Worksheets
For Each qt In ws.QueryTables
If qt.QueryType = xlODBCQuery Then
oldDir = ExtractDir(qt.Connection)
If oldDir  "" Then
qt.Connection = Replace(qt.Connection, oldDir, newDir, compare:= _
vbTextCompare)
qt.CommandText = Replace(qt.CommandText, oldDir, newDir, compare:= _
vbTextCompare)
End If
End If
qt.Refresh
Next
Next
Application.Calculation = lngCalcStatus
End Sub