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

[Berger1012]

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:

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:

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!

 

[John_w]

Replace:

    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:

    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]

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]

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:

.ListObject.Name = varName

I also noticed you use varName in this statement:

    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:

    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]

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]

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]

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:

    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]

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]

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.

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]

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!