so I want to create an automated querying for Yahoo Finance historical data (csv download) using Excel VBA. I set up a function so Excel would automatically query the ticker symbol alongside its start and end dates (K1, K2, K3 respectively).
Here is the code:
Sub YFIN_get()
'
' YFIN_get Macro
'
Dim ticker As String, sday, eday As Long
Columns("A:G").ClearContents
ticker = Range("K1")
sday = Range("K2")
eday = Range("K3")
'
ActiveWorkbook.Queries.Add Name:="Table 4", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Csv.Document(Web.Contents(""https://query1.finance.yahoo.com/v7/finance/download/" & ticker & "?period1=" & sday & "&period2=" & eday & "&interval=1d&events=history""),[Delimiter="","", Columns=7, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & " #""Use First Row as Headers"" = Table.PromoteHeaders(Source, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Change Type"" = Table" & _
".TransformColumnTypes(#""Use First Row as Headers"",{{""Date"", type date}, {""Open"", type number}, {""High"", type number}, {""Low"", type number}, {""Close"", type number}, {""Adj Close"", type number}, {""Volume"", Int64.Type}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Change Type"""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 4"";Extended Properties="""""), Destination:=Range("$A$1")). _
QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table 4]")
.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_4"
.Refresh BackgroundQuery:=False
End With
Application.CommandBars("Queries and Connections").Visible = False
End Sub
However, VBA always retrieves runtime error "a query with the name 'Table 4' already exists" whenever I run the code for the second time. When I debug the error it highlights the ActiveWorkbook.Queries.Add Name..... part.
Can anybody help me with the solution? Perhaps deleting the query? If so how should I delete the query? (I'm completely new to VBA so your help is much appreciated)
You can use this before trying to add it:
On Error Resume Next
ActiveWorkbook.Queries("Table 4").Delete
On Error GoTo 0
Related
I just started learning VBA and having some trouble making a macro to import from a folder with the same name.
I wanted to add "_current" or "_future" to the end of the folder name as its query name. Then have the data imported to specified columns in a specified workbook (let's say columns B-F in "worksheet 2").
I'm also not sure how to get the temporary ~$ files to not show in the query.
Any help would be appreciated!
ub Macro3()
'
' Macro3 Macro
'
'
Application.CutCopyMode = False
Selection.Copy
ActiveWorkbook.Queries.Add Name:="Training 1", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Folder.Files(""C:\Users\N14067\Documents\Training\VBA\Training 1"")," & Chr(13) & "" & Chr(10) & " #""Split Column by Delimiter"" = Table.SplitColumn(Source, ""Name"", Splitter.SplitTextByDelimiter("" "", QuoteStyle.Csv), {""Name.1"", ""Name.2"", ""Name.3""})," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(#""Split Column by Delimiter"",{{""Name.1"", type text}, {""Na" & _
"me.2"", type text}, {""Name.3"", type text}})," & Chr(13) & "" & Chr(10) & " #""Reordered Columns"" = Table.ReorderColumns(#""Changed Type"",{""Content"", ""Name.2"", ""Name.1"", ""Name.3"", ""Extension"", ""Date accessed"", ""Date modified"", ""Date created"", ""Attributes"", ""Folder Path""})," & Chr(13) & "" & Chr(10) & " #""Removed Columns"" = Table.RemoveColumns(#""Reordered Columns"",{""Content"", ""Name.2""," & _
" ""Name.1"", ""Extension"", ""Date accessed"", ""Date modified"", ""Date created"", ""Attributes"", ""Folder Path""})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Removed Columns"""
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Training 1"";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Training 1]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Training_1"
.Refresh BackgroundQuery:=False
End With
End Sub
The value passed to Formula is just a String, so you can concatenate in a suffix for the folder.
FYI Chr(13) & "" & Chr(10) can be replaced with vbCrLf
Try something like this:
Sub Macro3()
Dim suffix As String, wb As Workbook, ws As Worksheet
Set wb = ActiveWorkbook 'always good to create a specific workbook reference
suffix = "_current" 'for example
wb.Queries.Add Name:="Training 1", Formula:= _
"let" & vbLf & _
" Source = Folder.Files(""C:\Users\N14067\Documents\Training\VBA\Training 1" & suffix & """)," & vbCrLf & _
" #""Split Column by Delimiter"" = Table.SplitColumn(Source, ""Name"", " & _
"Splitter.SplitTextByDelimiter("" "", QuoteStyle.Csv), {""Name.1"", ""Name.2"", ""Name.3""})," & vbCrLf & _
" #""Changed Type"" = Table.TransformColumnTypes(#""Split Column by Delimiter""," & _
"{{""Name.1"", type text}, {""Name.2"", type text}, {""Name.3"", type text}})," & vbCrLf & _
" #""Reordered Columns"" = Table.ReorderColumns(#""Changed Type"",{""Content"", ""Name.2""," & _
" ""Name.1"", ""Name.3"", ""Extension"", ""Date accessed"", ""Date modified""," & _
" ""Date created"", ""Attributes"", ""Folder Path""})," & vbCrLf & _
" #""Removed Columns"" = Table.RemoveColumns(#""Reordered Columns"",{""Content"", ""Name.2""," & _
" ""Name.1"", ""Extension"", ""Date accessed"", ""Date modified"", ""Date created""," & _
" ""Attributes"", ""Folder Path""})" & vbCrLf & _
"in" & vbCrLf & _
" #""Removed Columns"""
Set ws = wb.Worksheets("worksheet2") 'get a reference to the destination worksheet
With ws.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;" & _
"Data Source=$Workbook$;Location=""Training 1"";Extended Properties=""""", _
Destination:=ws.Range("$B$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Training 1]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Training_1"
.Refresh BackgroundQuery:=False
End With
End Sub
I've written a script that imports certain .csv data, filters it and draws a graph from it. So far so good. Instead of using a static file I want to make it dynamic, I want to choose a file from the filemanger and import it as a table.
First I recorded a macro to see what happens (see macro2), then I wrote some code to open a file manger and create a table out of it (see macro TestImport). I keep getting an error at this line
Filename, Formula:= _ "let" & Chr
I think the problem is something with the header names-types. Is there a way to just give the delimiter and name as formula and let excel figure out the rest?
Macro "FileNameNoExtensionFromPath" is a macro to create a query which works, but I can't convert it to a table. I added the code, an example of the csv file, as well as a picture of how it looks when using a static path. Is there someone who can help me out?
Sub Macro2()
'
' Macro2 Macro
'
'
Range("A4").Select
ActiveWorkbook.Queries.Add Name:="48 04 AutoplaceCollisionsRobot_Results", _
Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Bron = Csv.Document(File.Contents(""C:\Users\sebastiaan\AppData\Local\KUKA\KUKA Sim Utilities PC 3.1\AutoOptimizePTP_TestFile_creationExcel\48.04 AutoplaceCollisionsRobot_Results.csv""),[Delimiter="";"", Columns=8, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & " #""Headers met verhoogd niveau"" = Table.PromoteHeaders(Bron, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " " & _
"#""Type gewijzigd"" = Table.TransformColumnTypes(#""Headers met verhoogd niveau"",{{""INDEX"", Int64.Type}, {""CYCLETIME"", Int64.Type}, {""X"", Int64.Type}, {""Y"", Int64.Type}, {""Z"", type text}, {""PTP NAME"", Int64.Type}, {""AXIS"", Int64.Type}, {""DEGREES"", Int64.Type}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Type gewijzigd"""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""48 04 AutoplaceCollisionsRobot_Results"";Extended Properties=""" _
, """"), Destination:=Range("$A$4")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array( _
"SELECT * FROM [48 04 AutoplaceCollisionsRobot_Results]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "_48_04_AutoplaceCollisionsRobot_Results"
.Refresh BackgroundQuery:=False
End With
End Sub
Sub TestImport()
Dim importPathVar As Variant
Dim Filename As String
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Add "Excel Files", "*.csv", 1
If .Show = True Then
importPathVar = .SelectedItems(1)
Filename = Dir(importPathVar)
MsgBox Filename
Else
MsgBox "You pressed Cancel"
Exit Sub
End If
End With
Filename = FileNameNoExtensionFromPath(importPathVar)
ActiveWorkbook.Queries.Add Name:= _
Filename, Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Csv.Document(File.Contents(""" & importPathVar & """),[Delimiter="";"", Columns=8, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & " #""Headers met verhoogd niveau"" = Table.PromoteHeaders(Bron, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " " & _
"#""Type gewijzigd"" = Table.TransformColumnTypes(#""Headers met verhoogd niveau"",{{""INDEX"", Int64.Type}, {""CYCLETIME"", Int64.Type}, {""X"", Int64.Type}, {""Y"", Int64.Type}, {""Z"", type text}, {""PTP NAME"", Int64.Type}, {""AXIS"", Int64.Type}, {""DEGREES"", Int64.Type}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Type gewijzigd"""
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location= " & Filename & ";Extended Proper" _
, "ties="""""), Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array( _
"SELECT * FROM [" & Filename & "]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = Filename
.Refresh BackgroundQuery:=False
End With
Application.CommandBars("Queries and Connections").Visible = False
End Sub
Function FileNameNoExtensionFromPath(ByVal strFullPath As String) As String
Dim intStartLoc As Integer
Dim intEndLoc As Integer
Dim intLength As Integer
intStartLoc = Len(strFullPath) - (Len(strFullPath) - InStrRev(strFullPath, "\") - 1)
intEndLoc = Len(strFullPath) - (Len(strFullPath) - InStrRev(strFullPath, "."))
intLength = intEndLoc - intStartLoc
FileNameNoExtensionFromPath = Mid(strFullPath, intStartLoc, intLength)
End Function
Sub importTable()
Dim myConnection As WorkbookConnection
Dim mFormula As String
mFormula = _
"let Source = Csv.Document(File.Contents(""C:\Users\sebastiaan\AppData\Local\KUKA\KUKA Sim Utilities PC 3.1\AutoOptimizePTP_TestFile_creationExcel\48.04 AutoplaceCollisionsRobot_Results.csv""),null,""#(tab)"",null,1252) in Source"
query2 = ActiveWorkbook.Queries.Add("query1", mFormula)
End Sub
I am trying to import data from a .csv file and then get the sum of last column.
The CSV file contents are:
Name,Age,City,Salary
Rick,25,Dallas,1800
Nick,28,Austin,2500
Jack,30,NYC,3500
Rose,26,Dallas,2400
The macro throws the following error.
The code looks like this.
Sub EmpMacro1()
'
' EmpMacro1 Macro
'
'
ActiveWorkbook.Queries.Add Name:="Emp_Datta", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Csv.Document(File.Contents(""C:\Users\Irfan.Shaikh\Desktop\Emp_Datta.csv""),[Delimiter="","", Columns=4, 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 Headers"",{{""Name"", type text}, {""Age"", Int64.T" & _
"ype}, {""City"", type text}, {""Salary"", Int64.Type}})" & 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=Emp_Datta;Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Emp_Datta]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Emp_Datta"
.Refresh BackgroundQuery:=False
End With
Range("C7").Select
ActiveCell.FormulaR1C1 = "Total"
Range("D7").Select
ActiveCell.FormulaR1C1 = "=SUM(Emp_Datta[Salary])"
Range("D8").Select
End Sub
I have two questions.
When I stop recording the macro and delete the imported data. There is an alert to confirm deleting the query. What is the impact of Yes and No?
I looked into the web for the error but did not find a solution. Is it related to me deleting the query when I delete the imported data?
If you are deleting the query by deleting the Range (and answering "Yes" to the question), it seems you are only changing it into a connection-only query and not really deleting it. You need to actually delete the query, either with VBA code or in the Queries and Connections window, to really delete it.
Another problem with your query is that you will be creating multiple ListObjects with the same DisplayName. This will also cause a runtime error.
However, if the tables are on separate worksheets, as is the case with your query, they can have the same Name and Excel will adjust the DisplayName by appending a _n where n is a number, so as to prevent duplicate naming.
(You still cannot have tables with the same Name on the same worksheet).
So I would try:
Const sName As String = "Emp_Datta"
On Error GoTo delQuery
ActiveWorkbook.Queries.Add Name:=sName, Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Csv.Document(File.Contents(""C:\Users\Irfan.Shaikh\Desktop\Emp_Datta.csv""),[Delimiter="","", Columns=4, 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 Headers"",{{""Name"", type text}, {""Age"", Int64.T" & _
"ype}, {""City"", type text}, {""Salary"", Int64.Type}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
On Error GoTo 0
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Emp_Datta;Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Emp_Datta]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
'---------------------
.ListObject.Name = sName
'---------------------
.Refresh BackgroundQuery:=False
End With
Range("C7").Select
ActiveCell.FormulaR1C1 = "Total"
Range("D7").Select
ActiveCell.FormulaR1C1 = "=SUM(Emp_Datta[Salary])"
Range("D8").Select
Exit Sub
delQuery:
Dim v
For Each v In ActiveWorkbook.Queries
If v.Name = sName Then _
v.Delete
Resume
Next v
MsgBox "Error No: " & Err.Number & vbLf & Err.Description
Stop
End Sub
And, unless there is some reason to use ActiveWorkbook, I'd suggest changing those references to ThisWorkbook.
Also note that if you Refresh the query, you will overwrite the data table on the activesheet; whereas if you execute your macro, you will be creating a new table on a new worksheet.
I have a column of dates (in Excel spreadsheet) and would like to insert these dates into the url line in the web query to generate an exchange rate tables which I would like to put them in the spreadsheets. For example:
Column A
2019-12-09
2019-12-08
2019-12-07
For each of these dates in column A, I would like insert them into the url line:
Below is a recorded VBA macro using --Get Data, from Web. Then I copy and paste the https://www.xe.com/currencytables/?from=USD&date=2019-12-10 into the url(pop up window), hit ok and choose table 0 to generate an exchange rate table for the date 2019-12-10. I would like to automate this process and use the dates in Column A. I don't have any experience in power query. Thank you for your help in advance.
Sub Macro2()
'
' Macro2 Macro
'
'
ActiveWorkbook.Queries.Add Name:="Table 0 (6)", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.Page(Web.Contents(""https://www.xe.com/currencytables/?from=USD&date=2019-12-08""))," & Chr(13) & "" & Chr(10) & " Data0 = Source{0}[Data]," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(Data0,{{""Currency code ??"", type text}, {""Currency name ??"", type text}, {""Units per USD"", type number}, {""USD per Unit"", type number}})" & 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=""Table 0 (6)"";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table 0 (6)]")
.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__6"
.Refresh BackgroundQuery:=False
End With
End Sub
For a test I've changed the url:
ActiveWorkbook.Queries.Add Name:="Table 0 (6)", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.Page(Web.Contents(""https://www.xe.com/currencytables/?from=USD&date=" & Format(DateSerial(2019, 12, 8), "yyyy-mm-dd") & """))," & Chr(13) & "" & Chr(10) & " Data0 = Source{0}[Data]," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(Data0,{{""Currency code"", type text}, {""Currency name"", type text}, {""Units per USD"", type number}, {""USD per Unit"", type number}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
ActiveWorkbook.Worksheets.Add
So under format(dateserial()) you can put your variable with date from the cell.
I've also changed Currency code ?? and Currency name ?? to Currency code and Currency name and edited them manually in power query editor in Excel the same way, as there is a problem with those arrows in column names.
If you would like to generate tables for all dates at once, then you have to solve that issue with arrows in the column name (or it is solved already?).
Next step is to make sure that table names are unique and generated automatically.
Last step would be the for loop to go through cells with dates.
UPDATE:
Ok, below you can find updated code. I've deleted column formatting for problematic columns with special characters. Variables for table name and date are created so now it will be extremely easy to extend that code to create tables for how much historic data you want :)
Option Explicit
Sub DownloadExchangeRates()
'Set variables
Dim wb As Workbook
Dim wbs As Worksheet
Dim mydate As Date
Dim table_name As String
Dim table_display_name As String
Set wb = ThisWorkbook
mydate = DateSerial(2019, 12, 7)
table_name = "Table " & Format(mydate, "yyyy-mm-dd")
table_display_name = "Table_" & Format(mydate, "yyyy_mm_dd")
' Create connection
wb.Queries.Add _
Name:=table_name, _
Formula:= _
"let" & Chr(13) & "" & Chr(10) & _
" Source = Web.Page(Web.Contents(""https://www.xe.com/currencytables/?from=USD&date=" & Format(mydate, "yyyy-mm-dd") & """))," & Chr(13) & "" & Chr(10) & _
" Data0 = Source{0}[Data]," & Chr(13) & "" & Chr(10) & _
" #""Changed Type"" = Table.TransformColumnTypes(Data0,{{""Units per USD"", type number}, {""USD per Unit"", type number}})" & Chr(13) & "" & Chr(10) & _
"in" & Chr(13) & "" & Chr(10) & _
" #""Changed Type"""
'Create new worksheet
wb.Worksheets.Add
Set wbs = wb.ActiveSheet
wbs.Name = "Currency for " & Format(mydate, "yyyy-mm-dd")
With wbs.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & """" & table_name & """" & ";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [" & table_name & "]")
.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_display_name
.Refresh BackgroundQuery:=False
End With
End Sub
If i try to add parameters by splicing the string of the URL with my variables it does not connect to the URL. To simplify the problem in my code i am hard coding the variable values but normally I would be pulling this from a named range.
I have tried power queries Advanced "Get Data from Web" feature but cant seem to add the parameters
Sub OpenWebStockDataTest()
'
' OpenWebStockDataTest Macro
'
'
Dim sticker As String
Dim exchange As String
sticker = "TGIF"
exchange = "CN"
ActiveWorkbook.Queries.Add Name:="Table 2", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.Page(Web.Contents(""https://finance.yahoo.com/quote/" & sticker & "." & exchange & "/history?p=" & sticker & "." & exchange & """))," & Chr(13) & "" & Chr(10) & " Data2 = Source{2}[Data]," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(Data2,{{""Date"", type date}, {""Open"", type number}, {""High"", type number}, {""Low"", type number}, {""Close*"", type number}, {""Adj Close**"", type number}, {""Volume"", Int64" & _
".Type}})" & 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=""Table 2"";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table 2]")
.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_2"
.Refresh BackgroundQuery:=False
End With
End Sub
The above code should connect to:
https://finance.yahoo.com/quote/TGIF.CN/history?p=TGIF.CN
Please someone Help!!!
You are getting lost in your quotes.
" Source = Web.Page(Web.Contents(""https://finance.yahoo.com/quote/"" & sticker & ""."" & exchange &""/history?p="" &sticker &"".""&exchange)),"
should be
" Source = Web.Page(Web.Contents(""https://finance.yahoo.com/quote/" & sticker & "." & exchange & "/history?p=" & sticker & "." & exchange & """)),"
Edit:
Sub OpenWebStockDataTest()
'
' OpenWebStockDataTest Macro
'
'
Dim sticker As String
Dim exchange As String
sticker = "TGIF"
exchange = "CN"
ActiveWorkbook.Queries.Add Name:="Table 2", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.Page(Web.Contents(""https://finance.yahoo.com/quote/" & sticker & "." & exchange & "/history?p=" & sticker & "." & exchange & """))," & Chr(13) & "" & Chr(10) & " Data2 = Source{2}[Data]," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(Data2,{{""Date"", type date}, {""Open"", type number}, {""High"", type number}, {""Low"", type number}, {""Close*"", type number}, {""Adj Close**"", type number}, {""Volume"", Int64" & _
".Type}})" & 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=""Table 2"";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table 2]")
.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_2"
.Refresh BackgroundQuery:=False
End With
End Sub