VBA - Create Power Query with source and name as variable from Excel sheet

Berger1012

New Member
Joined
Apr 19, 2020
Messages
6
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hello,
I am currently trying to create a Power Query with Excel VBA. I have stored the name and the data source of the Power Query table in an Excel sheet. I now want to start the makro for creating an Power Query table but the makro should read the name and the source of the data from the Excel sheet and place it into the code. I hope you unterstand what I am trying to explain.

This is my current code:
VBA Code:
Sub Makro1()

Dim varName As Variant
varName = Range("A1").Value

Dim varSource As Variant
varSource = Range("A2").Value

    ActiveWorkbook.Queries.Add Name:=varName, Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Quelle = Csv.Document(File.Contents(varSource),[Delimiter="","", Columns=10, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    #""Höher gestufte Header"" = Table.PromoteHeaders(Quelle, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    #""Analysierte JSON"" = Table.TransformColumns(#""Höher gestufte Header"",{{""<OPEN>"", Json.Docum" & _
        "ent}, {""<HIGH>"", Json.Document}, {""<LOW>"", Json.Document}, {""<CLOSE>"", Json.Document}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Analysierte JSON"""
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=varName;Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM varName")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = varName
        .Refresh BackgroundQuery:=False
    End With
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    Range("L15").Select
End Sub

As you see I have the name stored in the cell A1 and the source (Windows Explorer link) stored in cell A2. I saved these values in the variables varName and varSource. With the makrorecorder I recorded the code of creating an Power Query and then I just inserted the variables at those places, where these elements where before.

Here is the recorded code without the variables:

VBA Code:
Sub Makro1()
    ActiveWorkbook.Queries.Add Name:="appf us", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Quelle = Csv.Document(File.Contents(""C:\Users\Thoma\Downloads\Neuer Ordner\appf.us.txt""),[Delimiter="","", Columns=10, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    #""Höher gestufte Header"" = Table.PromoteHeaders(Quelle, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    #""Analysierte JSON"" = Table.TransformColumns(#""Höher gestufte Header"",{{""<OPEN>"", Json.Docum" & _
        "ent}, {""<HIGH>"", Json.Document}, {""<LOW>"", Json.Document}, {""<CLOSE>"", Json.Document}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Analysierte JSON"""
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""appf us"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [appf us]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "appf_us"
        .Refresh BackgroundQuery:=False
    End With
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    Range("L15").Select
End Sub

This is a sample data that I am trying to create a Power Query for: Download Sample Data

I don't really know how to insert the two variables in the code. I have coded before, just not in VBA and I hope someone of you has a soulution for my problem.

Any help will be appreciated. I wish you all a nice day!
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,757
Replace:
VBA Code:
    ActiveWorkbook.Queries.Add Name:=varName, Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Quelle = Csv.Document(File.Contents(varSource),[Delimiter="","", Columns=10, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    #""Höher gestufte Header"" = Table.PromoteHeaders(Quelle, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    #""Analysierte JSON"" = Table.TransformColumns(#""Höher gestufte Header"",{{""<OPEN>"", Json.Docum" & _
        "ent}, {""<HIGH>"", Json.Document}, {""<LOW>"", Json.Document}, {""<CLOSE>"", Json.Document}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Analysierte JSON"""

with:

VBA Code:
    ActiveWorkbook.Queries.Add Name:=varName, Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Quelle = Csv.Document(File.Contents(""" & varSource & """),[Delimiter="","", Columns=10, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    #""Höher gestufte Header"" = Table.PromoteHeaders(Quelle, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    #""Analysierte JSON"" = Table.TransformColumns(#""Höher gestufte Header"",{{""<OPEN>"", Json.Docum" & _
        "ent}, {""<HIGH>"", Json.Document}, {""<LOW>"", Json.Document}, {""<CLOSE>"", Json.Document}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Analysierte JSON"""
 

Berger1012

New Member
Joined
Apr 19, 2020
Messages
6
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Thank you so much for your answer!

I replaced the code. Now I get an error which says "run-time error 1004". I clicked on debugging and it showed me that the error occurs in this code line ".ListObject.DisplayName = varName".

What can I do to fix this problem?
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,757
That error occurs probably because the table name already exists. Without extra code to determine if the workbook connection, workbook query and table already exist, before running the code again you will need to manually delete the connection in the Excel UI, via Data tab -> Connections - Remove. And delete the Power Query via Data tab -> Queries -> under Workbook Queries in the right-hand panel -> Delete -> Are you sure? Delete.

In any case, I think the line should be:
VBA Code:
.ListObject.Name = varName
I also noticed you use varName in this statement:
VBA Code:
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=varName;Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
which should be changed to:
VBA Code:
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & varName & ";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
 

Berger1012

New Member
Joined
Apr 19, 2020
Messages
6
Office Version
  1. 365
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

Thank you so much for your help! I really appreciate it.

I just changed the code. I also checked if there are any other querrys or connections and there are none. It still gives me that error and I don't know why.
 

Berger1012

New Member
Joined
Apr 19, 2020
Messages
6
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
There has to be a problem with the variable varName because Excel tries to create a power query connection and if i open the power query editor I can see that the source (varSource) is right. Also the rest of the code was recorded with the makrorecorder so in my eyes the only error can occour with varName.
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,757

ADVERTISEMENT

Sorry, I missed the fact that you have and need quotes in "appf us" because of the space in the string. Change the code to:

VBA Code:
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
            "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""" & varName & """;Extended Properties=""""" _
            , Destination:=Range("$A$1")).QueryTable
 

Berger1012

New Member
Joined
Apr 19, 2020
Messages
6
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Still does not work. I am sorry that this topic is so complicated. But I want to thank you so much for your help!

I hope you can find a solution for this problem. The error is still "run-time error 1004, application or object-defined error". I really don't know how to fix this.
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,757
The macro should work if you delete the .ListObject.DisplayName = varName line. The error occurs because Excel doesn't like the space in "appf us" - you can't have a table (ListObject) with a space in its name. Without that line Excel assigns a default table name.

If you want to assign your own table name then you have to replace the space with another character, e.g. "_".

Try this macro, which assigns the same name, "appf_us" to the workbook query and table.
VBA Code:
Sub Macro1()
    
    Dim queryName As String, sourceFullName As String
    Dim pqDestinationCell As Range
    
    With ActiveSheet
        queryName = Replace(.Range("A1").Value, " ", "_")
        sourceFullName = .Range("A2").Value
        Set pqDestinationCell = .Range("A3")
    End With
    
    ActiveWorkbook.Queries.Add Name:=queryName, Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Quelle = Csv.Document(File.Contents(""" & sourceFullName & """),[Delimiter="","", Columns=10, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    #""Höher gestufte Header"" = Table.PromoteHeaders(Quelle, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    #""Analysierte JSON"" = Table.TransformColumns(#""Höher gestufte Header"",{{""<OPEN>"", Json.Docum" & _
        "ent}, {""<HIGH>"", Json.Document}, {""<LOW>"", Json.Document}, {""<CLOSE>"", Json.Document}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Analysierte JSON"""
    
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""" & queryName & """;Extended Properties=""""" _
        , Destination:=pqDestinationCell).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & queryName & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.Name = queryName 'also assigns same value to .ListObject.DisplayName
        .Refresh BackgroundQuery:=False
    End With
    
End Sub
 

Berger1012

New Member
Joined
Apr 19, 2020
Messages
6
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Thank you so much for this code!!! Now it works!

I really appreciate you help and your time. And I also wish you a nice day.

Thank you!
 

Watch MrExcel Video

Forum statistics

Threads
1,130,014
Messages
5,639,555
Members
417,098
Latest member
steverob

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top