Удалить новое соединение после запуска макроса

Question

У меня есть файл Excel, который в настоящее время извлекает данные для почасовых метрик, у меня есть 10 макроклавиш, которые с помощью vba соединяют веб-URL с нужной информацией для поиска нужной информации.

каждый раз, когда используется какая-либо из кнопок макроса, он создает новое соединение и добавляет его в список соединений.Есть ли способ, чтобы удалить соединение после того, как сделано?Этот код используется.

Спасибо за любую помощь!

Sub Hour6PPR()
'
' DataPull Macro
'
Application.ScreenUpdating = False
Dim SD As Date
Dim ED As Date
Dim STS As Integer
Dim ETS As Integer
Dim STE As Integer
Dim ETE As Integer
SD = Worksheets("Variables").Range("A2").Value
ED = Worksheets("Variables").Range("A2").Value
STS = Worksheets("Variables").Range("B7").Value
ETS = Worksheets("Variables").Range("C7").Value
STE = Worksheets("Variables").Range("D2").Value
ETE = Worksheets("Variables").Range("D2").Value
Application.ScreenUpdating = False
'On Error GoTo Errorcatch

If Worksheets("1200").Visible = xlSheetHidden Then
  Worksheets("1200").Visible = xlSheetVisible
End If
 Sheets("1200").Activate
 Sheets("1200").Select
 Cells.Select
Selection.ClearContents


Sheets("1200").Select
 With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;REDACTED", _
    Destination:=Range("$A$1"))
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = "2"
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
Worksheets("1200").Range("E135:G150").Copy
Worksheets("PPRData").Range("W4").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Recap").Select
End With
If Worksheets("1200").Visible = xlSheetVisible Then
  Worksheets("1200").Visible = xlSheetHidden
  End If
End Sub

Answer 1

For Each qr In ThisWorkbook.Queries
    qr.Delete
Next qr