Adding Parameters to connect and scrape data from a Dynamic URL - excel

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

Related

Change query with the same name

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

VBA throws an error when a string is changed to a variable with exact string

This is my vba code for powerquery function
ActiveWorkbook.Queries.Add Name:="Or ORder", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Excel.Workbook(File.Contents(""C:\Users\DDK\Downloads\excel.xlsx""), null, true)," & Chr(13) & "" & Chr(10) & " Sheet1_Sheet = Source{[Item=""Sheet1"",Kind=""Sheet""]}[Data]," & Chr(13) & "" & Chr(10) & " #""Promoted Headers"" = Table.PromoteHeaders(Sheet1_Sheet, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(#""Promoted Headers"",{{""Column1"", type any}" & _
", {""CROWN"", type any}, {""March 15th, 2021"", type text}, {""Column4"", type any}, {""Column5"", type any}})," & Chr(13) & "" & Chr(10) & " #""Removed Top Rows"" = Table.Skip(#""Changed Type"",2)," & Chr(13) & "" & Chr(10) & " #""Renamed Columns"" = Table.RenameColumns(#""Removed Top Rows"",{{""Column1"", ""QTY""}, {""CROWN"", ""ITEM""}, {""March 15th, 2021"", ""Part""}, {""Column5"", ""Price""}})," & Chr(13) & "" & Chr(10) & " #""Filter" & _
"ed Rows"" = Table.SelectRows(#""Renamed Columns"", each [QTY] <> null and [QTY] <> """")" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Filtered Rows"""
ActiveWorkbook.Worksheets.Add.Name = "Our Order"
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Or ORder"";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Or ORder]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Or_ORder"
.Refresh BackgroundQuery:=False
End With
When the file directory for the source is changed to a variable like this
Dim fileOrder as String
fileOrder = "C:\Users\Ddk\Downloads\excel.xlsx"
....
Source = Excel.Workbook(File.Contents(fileOrder), null, true)," & Chr(13) & "" & Chr(10) ""....
It throws an error when it reaches .Refresh BackgroundQuery:=False. Why is it? Even when it is the exact same string it gives an error [Expression.Error] The import Order matches no exports. Did you miss a module reference?
The thing is I want user to select the excel file for power query through VBA that's why I need to have a variable on file directory.
Why not use VBA to write the path to a named cell range, and have powequery read it in?
let Source = Csv.Document(File.Contents(Excel.CurrentWorkbook(){[Name="RangeName"]}[Content]{0}[Column1]),
or
let Source = Excel.Workbook(File.Contents(Excel.CurrentWorkbook(){[Name="RangeName"]}[Content]{0}[Column1]), null, true),

a query with the name already exists

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

Copying Excel data from one file to the other and reformatting

I am trying to copy data from one excel to the other and then reformat.
This is the code I am using:
ActiveWorkbook.Queries.Add Name:="Export", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Csv.Document(File.Contents(""C:\Users\Khawaja\Desktop\Export.csv""),[Delimiter="","", Columns=9, Encoding=65001, 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}, {""Surname"", type" & _
" text}, {""Email"", type text}, {""Action"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
Sheets.Add After:=ActiveSheet
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Export;Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Export]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = False
.ListObject.DisplayName = "Export"
.Refresh BackgroundQuery:=False
My source file has data in columns. Each column has a heading of Name, Surname, Email and Action. But when I run the macro, it is not able to detect the column heads.
This is the error I get:
The column 'Name' of the table was not found
Any idea how the error can be removed?
The argument you are looking for in Listobjects.add is XlListObjectHasHeaders. To that argument, you must type XlListObjectHasHeaders:=xlYes. You can also type xlGuess and Excel will guess if the tables has headers. In your case you have string data in both the header and data, therefore the default xlGuess is likely failing for that reason.
ActiveWorkbook.Queries.Add Name:="Export", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Csv.Document(File.Contents(""C:\Users\Khawaja\Desktop\Export.csv""),[Delimiter="","", Columns=9, Encoding=65001, 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}, {""Surname"", type" & _
" text}, {""Email"", type text}, {""Action"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
Sheets.Add After:=ActiveSheet
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Export;Extended Properties=""""" _
, XlListObjectHasHeaders:=xlYes, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Export]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = False
.ListObject.DisplayName = "Export"
.Refresh BackgroundQuery:=False

using vba to loop a column of dates into the url line for web query and retrieve an exchange rate table from xe.com/currencytables

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

Resources