Delete worksheet queries completely via Excel VBA - 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

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

Related

VBA: Run-time error '438': Object doesn't support this property or method

I'm trying to import a web based CSV file dynamically through changing the URL each time I run it. So I've got a URL that I'm dynamically managing by entering the last string as a variable that the user enters through an input box.
The problem is, that I'm getting a "Run-time error '438': Object doesn't support this method.
So this is an example of the URL that is being put through.You can change "BRZ" to "ASB" to see a different example if you wish.
http://cf3.myplumbingshowroom.com/scheduledScripts/brandDataAPI.cfm?brandCode=BRZ
As you can see, that link will take you right to the folder.
I have no idea what it means. I see that a lot of people are having the same problem, but the ".ListObject.DisplayName" is the portion of the code that is returning the error. I have the portion of the code underlined and highlighted for ease of reference.
Sub Macro3()
'Defining Variables
Dim myValue As Variant
Dim Link As Variant
'Creating a link
Link = "http://cf3.myplumbingshowroom.com/scheduledScripts/brandDataAPI.cfm?brandCode="
'creating a the variable to be passed into the link
myValue = InputBox("Enter your brand code here")
'completing our link
Link = "http://cf3.myplumbingshowroom.com/scheduledScripts/brandDataAPI.cfm?brandCode=" & myValue
'checking if it exists
MsgBox Link
'if the query already exists, we're going to delete it. Otherwise, we're going to ignore that function.
On Error Resume Next
ActiveWorkbook.Queries("brandDataAPI").Delete
On Error GoTo 0
Application.CutCopyMode = False
ActiveWorkbook.Queries.Add Name:="brandDataAPI", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Csv.Document(Web.Contents(" & Link & "),[Delimiter="","", Columns=11, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & " #""Promoted Headers"" = Table.PromoteHeaders(Source, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(#""Promoted Header" & _
"s"",{{""BrandName"", type text}, {"" BrandCode"", type text}, {"" BrandID"", Int64.Type}, {"" datalastUpdate"", type date}, {"" numproducts"", Int64.Type}, {""priceMethod"", type text}, {""URL"", type text}, {""showPrice"", Int64.Type}, {""MAP_YN"", Int64.Type}, {""MAP"", type text}, {""msrpNotes"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""brandDataAPI"";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [brandDataAPI]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = False
.Refresh BackgroundQuery:=True
***.ListObject.DisplayName***
End With
End Sub
This happens if you already have a table by this name. Particularly if you had a table by this name and you deleted it but it hasn't quite gone away despite not being visible.
So loop all the listobjects first and delete any with the proposed name e.g. "Hello" :
Option Explicit
Sub test()
Dim ws As Worksheet
Dim l As ListObject
For Each ws In ThisWorkbook.Worksheets
For Each l In ws.ListObjects
If l.Name = "Hello" Then l.Delete
Next l
Next ws
'Do your stuff
End Sub

Getting The Text Equivalent of An Enumeration

I am trying to create some simple tables in a worksheet that give the numeric equivalents of common enumerations like:
This example is for Border enumerated variables. This material can be found by wandering around in MSDN, but frequently I need to work when I am not online and this type of "help" is not available.
I am currently filling my little table with two separate loops:
Sub trythisB()
Dim i As Long
i = 1
For Each a In Array(xlInsideHorizontal, xlInsideVertical, xlEdgeLeft, xlEdgeRight, xlEdgeBottom, xlEdgeTop)
Cells(i, 2) = a
i = i + 1
Next a
End Sub
Sub trythisA()
Dim i As Long
i = 1
For Each a In Array("xlInsideHorizontal", "xlInsideVertical", "xlEdgeLeft", "xlEdgeRight", "xlEdgeBottom", "xlEdgeTop")
Cells(i, 1) = a
i = i + 1
Next a
End Sub
I would really like to avoid keeping two separate arrays; one for the text strings and the other for the enumerations.
Is there any way to get an enumeration from a text string or, alternatively, convert an enumeration into a text string??
Any suggestions will be appreciated.
I don't believe that you need to generate a list like this programmatically in order to create it. Microsoft provides a definition of all of them in MSDN:
https://msdn.microsoft.com/en-us/vba/excel-vba/articles/constants-enumeration-excel
You can download it from there and paste it into your spreadsheet. You could even make it dynamic with a web query so you can stay up to date with any changes. Here is a Macro that does just that:
Sub GetEnumerationDefinitions()
ActiveWorkbook.Queries.Add Name:="Enumerations", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.Page(Web.Contents(""https://msdn.microsoft.com/en-us/vba/excel-vba/articles/constants-enumeration-excel""))," & Chr(13) & "" & Chr(10) & " Data0 = Source{0}[Data]," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(Data0,{{""Name"", type text}, {""Value"", Int64.Type}, {""Description"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Enumerations"";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Enumerations]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_0"
.Refresh BackgroundQuery:=False
End With
End Sub

Refresh BackgroundQuery VBA

Sub OPInport(month As Integer, year As Integer)
'
' Macro6 Macro
'F und G
'
Dim selectedRange As Date
Dim WrkBook As Workbook
Dim WrkSheet As Worksheet
Set WrkBook = ActiveWorkbook
Set WrkSheet = ActiveSheet
selectedRange = DateSerial(year, month, 1)
MsgBox selectedRange
WrkBook.Sheets(1).Columns("G:H").NumberFormat = "dd.mm.yyyy"
Range("$A$1").Value = "Change"
Application.CutCopyMode = False
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"ODBC;DSN=OpsApps;UID=Alligatoah;Trusted_Connection=Yes;APP=Microsoft Office 2016;WSID=AT000616;DATABASE=OpsApps" _
, Destination:=Range("$B$1")).QueryTable
.CommandText = Array( _
"SELECT IPM_V_TV_URB.Customer, IPM_V_TV_URB.KNUM, IPM_V_TV_URB.DMRF, IPM_V_TV_URB.HeaderBoM, IPM_V_TV_URB.ProgramReleasedCosts, IPM_V_TV_URB.PlnLaunch, IPM_V_TV_URB.SystemSDate, IPM_V_TV" _
, _
"_URB.ActualCosts" & Chr(13) & "" & Chr(10) & "FROM OpsApps.dbo.IPM_V_TV_URB IPM_V_TV_URB" & Chr(13) & "" & Chr(10) & "WHERE (IPM_V_TV_URB.SystemSDate>={ts selectedRange & 00:00:00'})" _
)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_Query_from_OpsApps"
.Refresh BackgroundQuery:=False
End With
I want to select a specific range of data, but when i try to do that it says "Runtime Error 1004 General ODBC Error" and points out the last line, .Refresh BackgroundQuery:=False. Im quite new to VBA and cant really find a solution to the problem. It only started showing that error message when i changed the date in the where question with selectedDate.
You need to concatenate the selected date into your string - what you are doing currently is using the literal name of the variable as a date.
"_URB.ActualCosts" & Chr(13) & "" & Chr(10) & "FROM OpsApps.dbo.IPM_V_TV_URB IPM_V_TV_URB" & Chr(13) & "" & Chr(10) & "WHERE (IPM_V_TV_URB.SystemSDate>={ts '" & Format(selectedRange, "yyyy-mm-dd") & " 00:00:00'})"
You may need to change the date format used.

Excel VBA - I want to insert a date in a 'Get external data' query

I have this Sub with which I receive data from external connection. I already specified a date range :
((infactln.dtransact>{d '2015-09-01'}) AND (infact.dtransact<{d '2015-09-30'}))
I want this sub to give the user the possibility to change this date range without going in "Data - Connections - Properties"
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=Visual FoxPro Tables;UID=;;SourceDB=\\serverName\data.dbc;
SourceType=DBC;Exclusive=No;Background" _
), Array("Fetch=Yes;Collate=Machine;Null=Yes;Deleted=Yes;")),
Destination:= _Range("$A$1")).QueryTable.CommandText = Array(
_"SELECT infact.ctransid, infact.ccode, infactln.dtransact,
infactln.ccode, infactln.cdesc, infactln.bqte, infactln.bmontant,
infactln.bcoutant" & Chr(13) & "" & Chr(10) & "FROM infact infact,
infactln infactln" & Chr(13) & "" & Chr(10) & "WHERE infact.kid =" _
, _" infactln.cparentid AND ((infactln.dtransact>{d '2015-09-01'}) AND
(infact.dtransact<{d '2015-09-30'}))" _)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_Query_from_Visual_FoxPro_Tables"
.Refresh BackgroundQuery:=False
End With
You can (and should) use Format function:
https://msdn.microsoft.com/en-us/library/office/gg251755.aspx
Than you just give the user opportunity to specify specific dates in some cells, let's say these are "A1" and "B1". You just substitute the date values in your query with
" infactln.cparentid AND ((infactln.dtransact>{d '" & Format(Cells(1, "A"), "yyyy-MM-dd") & "'}) AND
(infact.dtransact<{d '" & Format(Cells(1, "B"), "yyyy-MM-dd") & "'}))"

Replacing the existing sheet in excel 2007 using VBA

Sub testmac()
'
' testmac Macro
'
'
ActiveWorkbook.Names.Add Name:="items", RefersToR1C1:= _
"=Report!R7C8:R486C11"
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=Excel Files;DBQ=path
), Array("P;DriverId=1046;MaxBufferSize=2048;PageTimeout=5;")), Destination:= _
Range("$A$1")).QueryTable
.CommandText = Array( _
"TRANSFORM first(`Dimension Value Code`)" & Chr(13) & "" & Chr(10) & "SELECT items.`No#`, items.`Description`" & Chr(13) & "" & Chr(10) & "FROM items" & Chr(13) & "" & Chr(10) & "GROUP BY items.`No#`, items.`Description`" & Chr(13) & "" & Chr(10) & "PIVOT `Dimension Code`" _
)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_Query_from_Excel_FilesXY"
.Refresh BackgroundQuery:=False
End With
End Sub
I am trying to make a pivot table with this code. The first try went well as it had no sheets. When I tried for the second time it gave me an error as the sheet already existed with table in it having the same name as the previous one.
The error is
Run-time error '1004': Application-defined or object defined error
When I delete the worksheet created in the previous step and try running the macro again works properly, but it does not works without deleting it.
you can try this at the top:
on error resume next
ActiveWorkbook.Sheets("your sheet").delete
on error goto 0
if it exists, it will be deleted and your code will make the new one. Does it help?