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]

My previous macro requires you to delete the Workbook Query and the Table named "appf_us" before running the macro again.

Here is an improved version which deletes the existing Workbook Connection, Workbook Query and Table, allowing you to run the macro many times. Another refinement is that the Connection, Query and Table are given specific names.

Public Sub Macro1_Run_Many()
    
    Dim queryName As String, sourceFullName As String
    Dim pqDestinationCell As Range
    Dim wbQueryName As String, wbConnectionName As String, pqTableName As String
    Dim wbQuery As WorkbookQuery
    Dim wbConnection As WorkbookConnection
    Dim pqTable As ListObject
    
    With ActiveSheet
        queryName = Replace(.Range("A1").Value, " ", "_")
        sourceFullName = .Range("A2").Value
        Set pqDestinationCell = .Range("A3")
        wbQueryName = queryName & "_WbQuery"
        wbConnectionName = queryName & "_WbConn"
        pqTableName = queryName & "_Table"
    End With
    
    'Delete existing workbook connection, workbook query and table for this data
    
    On Error Resume Next
    ActiveWorkbook.Connections(wbConnectionName).Delete
    ActiveWorkbook.Queries(wbQueryName).Delete
    ActiveSheet.ListObjects(pqTableName).Delete
    On Error GoTo 0
           
    Set wbQuery = ActiveWorkbook.Queries.Add(Name:=wbQueryName, 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""")
    
    wbQuery.Description = "Workbook Query to load data from " & sourceFullName
    
    Set pqTable = ActiveSheet.ListObjects.Add(SourceType:=0, Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""" & wbQueryName & """;Extended Properties=""""", _
                                              Destination:=pqDestinationCell)
    
    'Assign names to Power Query table and Connection
    
    pqTable.Name = pqTableName
    pqTable.Comment = "Table for Workbook Query " & wbQueryName     'This comment is shown in Formulas tab -> Name Manager
    pqTable.QueryTable.WorkbookConnection.Name = wbConnectionName
    pqTable.QueryTable.WorkbookConnection.Description = "Workbook Connection to external data source " & sourceFullName
    
    With pqTable.QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & wbQueryName & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
    End With
    
    pqTable.QueryTable.Refresh BackgroundQuery:=False
    
End Sub

 

[Drisso in Vegas]

This thread helped me immensely. Thank you!

 

[HernusB]

John_w, you are a GENIUS