I am pretty new to VBA and am learning how to add connections to databases in excel. I currently have a macro that creates a query called "Query1" it then queries my database and returns the correct table. I would like to be able to delete the query after the table is output to the excel sheet so that I can run the macro again with slightly modified conditions eg different dates.
Sub Macro2()
'
' Macro2 Macro
'
ActiveWorkbook.Queries.Add Name:="Query1", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Odbc.Query(""dsn=Database"", ""SELECT DISTINCT c.IP_TREND_VALUE AS """"PRODUCT"""", c.IP_TREND_TIME , s.IP_TREND_TIME AS TIMES, s.IP_TREND_VALUE AS """"Wttotal""""#(lf)FROM """"Product"""" AS c , """"wtTotal"""" as s#(lf)#(lf)Where #(lf)#(tab) c.TIME Between '1-JUN-17 05:59:00' AND '2-" & _
"JUN-17 05:59:00' AND c.TIME = s.IME#(lf)"")" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " Source" & _
""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Query1" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Query1]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Query1"
.Refresh BackgroundQuery:=False
End With
End Sub
I would like to add something like the following after the table is placed into the worksheet
ActiveWorkbook.Queries.Delete = Name: = "Query1"
But obviously this doesn't exist. How can I remove the query or make it so that the macro can be run without having to delete "Query1"?
Try adding the following line.
The Activeworkbook.Queries() takes a Name or Index
ActiveWorkbook.Queries("Query1").Delete
try this:
For Each Worksheet In ThisWorkbook.Worksheets
Qcount = Worksheet.QueryTables.Count
If Qcount > 0 Then
For Each QueryTable In ws.QueryTables
QueryTable.Delete
Next
End If
Next Worksheet
Delete all Queries in an Excel Workbook using
Dim Qus As WorkbookQuery
For Each Qus In ActiveWorkbook.Queries
Qus.Delete
Next
Related
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
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.
The following is the VBA code I am using to query the database. After querying the data base I would like to be able to perform a separate query on the new table I have created. I would like to do this query using TIMES in date format as the parameter. However, when excel loads the information from the database it loads the TIMES column as a text format instead of a date format. This makes querying by saying
.ComandText = Array("SELECT TIMES FROM [QUERY1 WHERE TIMES BETWEEN '24-JUN-17 05:59:00' and '25-JUN-17 02:00:00' ]
give an error.
I know how to change the column format by opening up the query and manually changing the format I am hoping there is a way to do this in VBA
ActiveWorkbook.Queries.Add Name:="Query1", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Odbc.Query(""dsn=Database"", ""SELECT c.IP_VALUE AS """"PRODUCT"""", c.IP_TIME as CTIMES , s.IP_TIME AS TIMES, s.IP_VALUE AS """"Weight""""#(lf)FROM """"Product"""" AS c , """"Weight"""" as s#(lf)#(lf)WHERE c.IP_TIME between '24-JUN-17 05:59:00' AND '29-JUN-17 06:00:00'"")" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " Source"
Sheets.Add After:=ActiveSheet
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Query1" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT TIMES FROM [Query1]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Query1"
End With
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") & "'}))"
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?