Stan.N
Stan.N

Reputation: 41

Delete worksheet queries completely via Excel VBA

I have code that creates a query table. After creating it I pull out the data I want and then I'm done with that query. I don't want a bunch of query tables hanging around taking up space so I want to immediately delete it. I use

QueryTables.Delete

ActiveWorkbook.Connections.Item(i).Delete

The problem is that the query table connection is still there. So if I try to make another query using the same name, it tells me that one already exists and it can't make it.

I want any record of that table existing to be completely gone.

Here is my code:

Sub Macro8()

Dim currency1 As String
Dim currency2 As String

currency1 = ActiveSheet.Range("currency1")
currency2 = ActiveSheet.Range("currency2")

Range("clear").Select
Selection.ClearContents

ActiveWorkbook.Queries.Add Name:="FXFWD", Formula:= _
    "let" & Chr(13) & "" & Chr(10) & "    Source = Web.Page(Web.Contents(""http://www.investing.com/currencies/" & currency2 & "-" & currency1 & "-forward-rates""))," & Chr(13) & "" & Chr(10) & "    Data0 = Source{0}[Data]," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Data0,{{"""", type text}, {""Name"", type text}, {""Bid"", type number}, {""Ask"", type number}, {""High"", type number}, {""Low"", type number}, {""Chg."", type number}, {""Time""," & _
    " type text}})," & Chr(13) & "" & Chr(10) & "    #""Removed Columns"" = Table.RemoveColumns(#""Changed Type"",{""""})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Removed Columns"""
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Book1"
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
    "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=FXFWD" _
    , Destination:=Range("$A$1")).QueryTable
    .CommandType = xlCmdSql
    .CommandText = Array("SELECT * FROM [FXFWD]")
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = False
    .ListObject.DisplayName = "FXFWD"
    .Refresh BackgroundQuery:=False
End With

Sheets("Book1").Rows("1:33").Copy
Sheet1.Rows("18").PasteSpecial xlPasteValues
Sheets("Book1").Select

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim con As Object
Dim ws As Worksheet
Dim qryT As QueryTable

For Each con In ThisWorkbook.Connections
    con.Delete
Next con
For Each ws In ThisWorkbook.Worksheets
    For Each qryT In ws.QueryTables
         qryT.Delete
    Next qryT
Next ws

Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Sheet1.Select
End Sub

Upvotes: 4

Views: 12212

Answers (1)

robotik
robotik

Reputation: 2017

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

Upvotes: 3

Related Questions