Automate Excel Power Query - excel

Hello I am trying to see how I can change this macro and make it so that it will run Power Query below, but for all files in the same folder the excel is in. In this example #3 is the file name that would need to change each time it loops to a new file.
Sub Get_Data()
ExecuteExcel4Macro _
"(""#3"",""let" & Chr(10) & " Source = Excel.Workbook(File.Contents(""/Users/tmayfield/Library/CloudStorage/OneDrive-Personal/Glaeser Park Territories/New Locations/#3.xlsx""), null, true)," & Chr(10) & " Navigation = Source{[Item = ""#3"", Kind = ""Sheet""]}[Data]," & Chr(10) & " #""Promoted headers"" = Table.PromoteHeaders(Navigation, [PromoteAllScalars = true])," & Chr(10) & " #""Changed column type"" = Table.Trans" & _
"formColumnTypes(#""Promoted headers"", {{""#"", type text}, {""Street "", type text}, {""Number"", Int64.Type}, {""Status"", type any}, {""Date"", type any}})" & Chr(10) & "in" & Chr(10) & " #""Changed column type"""")" & _
""
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=#3;Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [#3]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = False
.PreserveColumnInfo = False
.ListObject.DisplayName = "Table_ExternalData_2"
.Refresh BackgroundQuery:=False
End With
End Sub

Related

Symbol preventing Import from web in VBA

I'm pretty new to VBA and trying to record a macro that imports the table from this website:
https://www.x-rates.com/table/?from=CAD&amount=1
I can import it manually just fine, but when recoding the macro, VBA does not understand the triangle symbol used in the heading and replaces it with a question mark in the VBA code.
I've tried removing/replacing the question mark in the VBA code, but then it does not match the table and I get an error because the heading couldn't be found. I've also tried transforming the data when recording the macro and removing the triangles from the headings, but no luck.
Does anybody have a way to work around this? Below is the code from the recorded macro if it helps. Thanks!
ActiveWorkbook.Queries.Add Name:="Table 1", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.Page(Web.Contents(""https://www.x-rates.com/table/?from=CAD&amount=1""))," & Chr(13) & "" & Chr(10) & " Data1 = Source{1}[Data]," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(Data1,{{""Canadian Dollar?"", type text}, {""1.00 CAD??"", type number}, {""inv. 1.00 CAD??"", type number}})" & 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=""Table 1"";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table 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 = "Table_1"
.Refresh BackgroundQuery:=False
End With

Scraping with Excel VBA

I want to scrape data from some pages. I have a problem with loop -> each red-border rectangle I want to fill-in with "i" parameter, which denotes number of pages. Could someone tell me how to do it?
Sub czwarta()
Dim i As Integer
For i = 6 To i = 100
ActiveWorkbook.Queries.Add Name:="Table 0 (6)", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Źródło = Web.Page(Web.Contents(""https://wcn.pl/archive?page=6""))," & Chr(13) & "" & Chr(10) & " Data0 = Źródło{0}[Data]," & Chr(13) & "" & Chr(10) & " #""Zmieniono typ"" = Table.TransformColumnTypes(Data0,{{""Zdjęcie/Numer"", type text}, {""Opis"", type text}, {""Stan"", type text}, {""Cena"", Currency.Type}, {""Data"", type date}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Zmieniono typ"""
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$131")).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
ActiveWindow.SmallScroll Down:=30
Range("A157").Select
Next i
End Sub

Importing data format changed

I have been designed a script that was working with importing data from a file and then creating relevant table and and charts in the excel.
Unfortunately the data format of the input file changed and now the script gives an error. Although the change is just of the delimiter but changing the delmiter option in the script does not make the script work.
The format of the file is the following:
Old format:
Name,"Surname","Email","Company","File Name"
New format:
Name;Surname;Email;Company;File Name
The code I am using is the following:
ActiveWorkbook.Queries.Add Name:="MyExport", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Csv.Document(File.Contents(""C:\Users\Khawaja\Desktop\MyExport.csv""),[Delimiter="";"", Columns=5, 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}, {""Company"", type text}, {""File Name"", 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=MyExport;Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [MyExport]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = False
.ListObject.DisplayName = "MyExport_2"
.Refresh BackgroundQuery:=False
End With
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
ActiveSheet.Select
In this code, I have changed the delimiter but the error is that it cannot recognize the word Name in the file which means there is something else I need to change
The error I get is above in the image.
The old and new files respectively
https://i.stack.imgur.com/3nWDQ.png
https://i.stack.imgur.com/JJesh.png

Importing data from CSV file error: A query with the name ... already exists

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.

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

Resources